Yazilim Mutfagi Forumu Homepage
Forum Home Forum Home > MS OFFICE > Excel
  New Posts New Posts RSS Feed - Excelde Klasörden Resim Çagirma ve Gösterme
  FAQ FAQ  Forum Search   Register Register  Login Login


Excelde Klasörden Resim Çagirma ve Gösterme

 Post Reply Post Reply
Author
Message
yazilimmutfagi View Drop Down
Admin Group
Admin Group
Avatar

Joined: 01-Ekim-2012
Status: Offline
Points: 21
Post Options Post Options   Thanks (0) Thanks(0)   Quote yazilimmutfagi Quote  Post ReplyReply Direct Link To This Post Topic: Excelde Klasörden Resim Çagirma ve Gösterme
    Posted: 08-Mart-2016 at 14:35
Bir excel sayfasinda girdiginiz bilgilere göre belirli bir klasör içindeki ilgili resmi alip excelin ilgili hücresine yazdima ihtiyaciniz var ise bu makalemiz tam size göre.
Makalenin Devamina Ulasmak için Tiklayiniz
Back to Top
Sponsored Links


Back to Top
ylharef View Drop Down
Newbie
Newbie


Joined: 04-Haziran-2017
Location: Rize
Status: Offline
Points: 1
Post Options Post Options   Thanks (0) Thanks(0)   Quote ylharef Quote  Post ReplyReply Direct Link To This Post Posted: 04-Haziran-2017 at 17:33
Merhaba,

A?a?ydaki kodlary ayny ?ekilde uyguladym vede çaly?ty fakat resimlerin doyutlary ayny
olmady?yndan bazy resimler hücrelerin dy?yna ta?yyor veya resim küçük geliyor tam olarak
hücreye sy?dyrabilmek mümkünmü yardymcy olursanyz sevinirim. ?imdiden te?ekkürler ederim







Public Function DosyaVarmi(dosyayolu As String) As Boolean
    On Error GoTo Çikis
    If Not Dir(dosyayolu, vbDirectory) = vbNullString Then DosyaVarmi = True
     
Çikis:
    On Error GoTo 0
End Function
 
'worksheette bir degisiklik oldugunda bu kisim çalisiyor
Private Sub Worksheet_Change(ByVal Target As Range)
 
'degisiklik b sutunundami olmus diye kontrol et, degilse direk olarak fonksiyondan çik
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
 
'herhangi bir hata olusursa Çikis labelina git
On Error GoTo Çikis:
 
' ilk olarak yüklü olan Resimleri silelim
ActiveSheet.DrawingObjects.Delete
 
Dim ResimDosyaYolu As String
Dim Resim As Object
 
'b deki 5 ile 12 arasindaki satirlari kontrol edip resim atamasi yapiyoruz, siz burayi isteginize göre artirabilirsiniz
For i = 5 To 12
    'aktif sayfanin path bilgisini alip, seçilen ürün idyi sonuna ekliyoruz ve dosyayi aliyoruz
    ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("b" & i) & ".jpg"
 
    'dosya yok ise hataya düsmemek için asagidaki kontrolü yapiyoruz.
    If DosyaVarmi(ResimDosyaYolu) Then
         ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("b" & i) & ".jpg"
        Else
           ResimDosyaYolu = ActiveWorkbook.Path & "\yok.jpg"
        End If
         
    'resmi olusturuyoruz.
     Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     'Resmi boyutlandiriyoruz
     With Range("f" & i)
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
 
Next i
 
Çikis:
 
End Sub
Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 11.10
Copyright ©2001-2017 Web Wiz Ltd.

This page was generated in 0,469 seconds.