- Katılım
- 29 Eylül 2019
- Mesajlar
- 1
- Excel Vers. ve Dili
- excel 2016
merhabalar basit düzeyde vba da çalışmalar yapıyordum çalıştığım kurumda personellerin verilerini içeren bilgi kartlarını oluşturmaya başladım veri tabanı oluşturup düşeyara ile kartı hazırladım ardından basit bir kodla çalışma kitabının bulunduğu klasöre personel resimlerini de ekleyerek kartın B7 de bulunan sicilden A1' e resmi çekiyordum buraya kadar bir sorunum olmadı fakat Windows işletim sisteminde hazırladığım bu sistem Mac os da çalıştıramadım Türkçe karakterleri de düzeltmeme rağmen hala bir sonuç alamadım sizin bir çözüm öneriniz olur mu ?
Not: mac de resmin gelmesi gereken yerde aldığım hata "Bağlantılı resim görüntülenemiyor. Dosya taşınmış, yeniden adlandırılmış veya silinmiş olabilir. Bağlantının doğru dosya ve konuma işaret ettiğini doğrulayın.
Private Sub Worksheet_Change(ByVal Target As Range)
'Hucrede degisiklik varsa gosterecek
If Intersect(Target, [B7]) Is Nothing Then Exit Sub
'Hata kontrolu
On Error GoTo cikis
'Resimleri Silme
ActiveSheet.DrawingObjects.Delete
'Resim Yolunun Bulunmasi
Dim ResimYolu As Variant
Dim Resim As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("B7") & ".PNG"
'Resmi Olusturma
Set Resim = ActiveSheet.pictures.Insert(ResimYolu)
'Resmi Boyutlandirma
With Range("A1" & satir)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
cikis:
End Sub
zdmrkasm Kayıt: 08 Haz 2019 10:52Yaş: 23İleti: 1 Cinsiyet: BayBulunduğunuz İl / Semt: Ümraniye / İSTANBUL
Not: mac de resmin gelmesi gereken yerde aldığım hata "Bağlantılı resim görüntülenemiyor. Dosya taşınmış, yeniden adlandırılmış veya silinmiş olabilir. Bağlantının doğru dosya ve konuma işaret ettiğini doğrulayın.
Private Sub Worksheet_Change(ByVal Target As Range)
'Hucrede degisiklik varsa gosterecek
If Intersect(Target, [B7]) Is Nothing Then Exit Sub
'Hata kontrolu
On Error GoTo cikis
'Resimleri Silme
ActiveSheet.DrawingObjects.Delete
'Resim Yolunun Bulunmasi
Dim ResimYolu As Variant
Dim Resim As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("B7") & ".PNG"
'Resmi Olusturma
Set Resim = ActiveSheet.pictures.Insert(ResimYolu)
'Resmi Boyutlandirma
With Range("A1" & satir)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
cikis:
End Sub
zdmrkasm Kayıt: 08 Haz 2019 10:52Yaş: 23İleti: 1 Cinsiyet: BayBulunduğunuz İl / Semt: Ümraniye / İSTANBUL
