[]
Excel'de değişken resim ekleme
selamlar,
şimdi diyelim elimde bir tablo var, bu tablonun A kolonu barkod yazılarından oluşuyor. aynı zamanda bu listedekiler, barkod olarak da bilgisayarımda bir klasörde kayıtlı (.png resim dosyası olarak ve barkod ismiyle aynı isimde).
şimdi yapmak istediğim şey şu ki; Excel bu A kolonundaki satırları tek tek okusun ve isme denk gelen resmi Excel içerisine koysun.
VBA olarak bişeyler buldum internette ama çalışmadı. hatta aşağıda da bulduğum kodu görebilirsiniz (tam aradığım şeyi de bulmuştum aslında):
Private Sub Worksheet_Change(ByVal Target As Range)
'Presumes graphic name is in cell A1, CHANGE to suit
If Target = Range("A1") Then
'Gets the value of cell A1, CHANGE to match 'Target' range
pic = Range("A1")
'Ignores error if previous graphic not found
On Error Resume Next
'Deletes previous graphic if exists
ActiveSheet.Shapes(1).Cut
'Resets error if there was one
On Error Goto 0
'Inserts graphic. Change "C:\songs\" to your directory and
' change ".jpg" to your file extension. Keep the syntax tho!
'
' ("YourDrive:\YourPath\" & pic & ".YourFileExtension"
'
ActiveSheet.Pictures.Insert ("C:\songs\" & pic & ".jpg")
End If
End Sub
bir el atan çıkar belki, uzun süredir de Excel sormamıştım içim bir garip oldu :( acaba bilen çıkar mı artık...
şimdiden teşekkürler.
şimdi diyelim elimde bir tablo var, bu tablonun A kolonu barkod yazılarından oluşuyor. aynı zamanda bu listedekiler, barkod olarak da bilgisayarımda bir klasörde kayıtlı (.png resim dosyası olarak ve barkod ismiyle aynı isimde).
şimdi yapmak istediğim şey şu ki; Excel bu A kolonundaki satırları tek tek okusun ve isme denk gelen resmi Excel içerisine koysun.
VBA olarak bişeyler buldum internette ama çalışmadı. hatta aşağıda da bulduğum kodu görebilirsiniz (tam aradığım şeyi de bulmuştum aslında):
Private Sub Worksheet_Change(ByVal Target As Range)
'Presumes graphic name is in cell A1, CHANGE to suit
If Target = Range("A1") Then
'Gets the value of cell A1, CHANGE to match 'Target' range
pic = Range("A1")
'Ignores error if previous graphic not found
On Error Resume Next
'Deletes previous graphic if exists
ActiveSheet.Shapes(1).Cut
'Resets error if there was one
On Error Goto 0
'Inserts graphic. Change "C:\songs\" to your directory and
' change ".jpg" to your file extension. Keep the syntax tho!
'
' ("YourDrive:\YourPath\" & pic & ".YourFileExtension"
'
ActiveSheet.Pictures.Insert ("C:\songs\" & pic & ".jpg")
End If
End Sub
bir el atan çıkar belki, uzun süredir de Excel sormamıştım içim bir garip oldu :( acaba bilen çıkar mı artık...
şimdiden teşekkürler.
Alttaki döngüyle A kolonundaki tüm değerler için belirtilen klasörde aynı isimdeki resmi dosyaya yükleyebilirsin.
Ancak resimler üst üste geliyor, bu sorun olacaksa ayrıca bir çözüm gerekir resimlerin boyutuna göre.
Private Sub resim()
For i = 1 To [a65536].End(3).Row
pic = Cells(i, 1)
On Error Resume Next
ActiveSheet.Pictures.Insert ("C:\" & pic & ".png")
Next i
End Sub
Activesheet ile başlayan satırdaki c:\ adresinin devamına resimlerin bulunduğu klasörü yazman gerekiyor sadece.
Ancak resimler üst üste geliyor, bu sorun olacaksa ayrıca bir çözüm gerekir resimlerin boyutuna göre.
Private Sub resim()
For i = 1 To [a65536].End(3).Row
pic = Cells(i, 1)
On Error Resume Next
ActiveSheet.Pictures.Insert ("C:\" & pic & ".png")
Next i
End Sub
Activesheet ile başlayan satırdaki c:\ adresinin devamına resimlerin bulunduğu klasörü yazman gerekiyor sadece.
- cakabo
(22.07.11 11:46:27)
1
