- Katılım
- 12 Şubat 2015
- Mesajlar
- 520
- Excel Vers. ve Dili
- Office 2016 TR 64 Bit Windows
- Altın Üyelik Bitiş Tarihi
- 01-02-2027
Üstadlar Merhaba;
Aşağıdaki makro ile otomatik proforma resmi çağırmaktayım. Ancak excelimi karşıya atınca resimler çıkmıyor. Bu sorunu çözmek adına nasıl bir revize yapmam gerekmekte? Yardımcı olur musunuz ?
Aşağıdaki makro ile otomatik proforma resmi çağırmaktayım. Ancak excelimi karşıya atınca resimler çıkmıyor. Bu sorunu çözmek adına nasıl bir revize yapmam gerekmekte? Yardımcı olur musunuz ?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
'----------------------------------------Mevcut Resmi Hücreden Kaldır-------------------------------
Dim ResimA As Picture, Alan As Range
Set Alan = Range("A8:A1000")
For Each ResimA In ActiveSheet.Pictures
If Not Intersect(ResimA.TopLeftCell, Alan) Is Nothing Then
ResimA.Delete
End If
Next
Set Alan = Nothing
'------Resmi Hücreye Çağır-------------------------------
Dim ResimYolu As Variant
Dim Resim As Object
For Satır = 8 To 1000
Yol = "\\Server\Proforma Resimler"
On Error GoTo 10
ResimYolu = Dir(Yol & "\" & Range("A" & Satır) & ".jpg", vbNormal)
If ResimYolu <> "" Then
Set Resim = ActiveSheet.Pictures.Insert(Yol & "\" & ResimYolu)
With Range("A" & Satır)
Resim.Top = .Top + 5 'Yukarıdan Mesafe
Resim.Left = .Left + 5 'Soldan Mesafe
Resim.Height = Resim.Height 'Resim yukseklik (şu an orjinal ayarlı)
Resim.Width = Resim.Width 'Resim genişlik (şu an orjinal ayarlı)
End With
End If
Next Satır
10
End Sub