- Katılım
- 21 Mart 2015
- Mesajlar
- 13
- Excel Vers. ve Dili
- Microsoft Office Professional Plus 2010
SORU : Macro1 Çalışıyor, ancak Makro2 yi çalıştırınca Makrıo1 deki resim kayboluyor. Her iki resmin de kalması için nasıl bir kod gerekir, yardımlarınızı rica ederim
Private Sub Worksheet_Change(ByVal Target As Range)
Call Macro1(Target)
Call Macro2(Target)
End Sub
Sub Macro1(ByVal Target As Range)
If Intersect(Target, [c4]) Is Nothing Then Exit Sub
'hata kontlolü
On Error GoTo Çıkış
'Resimleri Sil
ActiveSheet.DrawingObjects.Delete
'Resim Yolunun Bulunması
Dim ResimYolu As Variant
Dim Resim As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("c4") & ".jpg"
'Resim oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
'Resim Boyutlandır
With Range("c3" & satır)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Çıkış:
End Sub
Sub Macro2(ByVal Target As Range)
If Intersect(Target, [c9]) Is Nothing Then Exit Sub
'hata kontlolü
On Error GoTo Çıkış
'Resimleri Sil
ActiveSheet.DrawingObjects.Delete
'Resim Yolunun Bulunması
Dim ResimYolu As Variant
Dim Resim As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("c9") & ".jpg"
'Resim oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
'Resim Boyutlandır
With Range("c8" & satır)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Çıkış:
End Sub
https://drive.google.com/open?id=1rfM1jI4Mhds8_YY2bl5E-vbXMUsPvpuP
Private Sub Worksheet_Change(ByVal Target As Range)
Call Macro1(Target)
Call Macro2(Target)
End Sub
Sub Macro1(ByVal Target As Range)
If Intersect(Target, [c4]) Is Nothing Then Exit Sub
'hata kontlolü
On Error GoTo Çıkış
'Resimleri Sil
ActiveSheet.DrawingObjects.Delete
'Resim Yolunun Bulunması
Dim ResimYolu As Variant
Dim Resim As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("c4") & ".jpg"
'Resim oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
'Resim Boyutlandır
With Range("c3" & satır)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Çıkış:
End Sub
Sub Macro2(ByVal Target As Range)
If Intersect(Target, [c9]) Is Nothing Then Exit Sub
'hata kontlolü
On Error GoTo Çıkış
'Resimleri Sil
ActiveSheet.DrawingObjects.Delete
'Resim Yolunun Bulunması
Dim ResimYolu As Variant
Dim Resim As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("c9") & ".jpg"
'Resim oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
'Resim Boyutlandır
With Range("c8" & satır)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Çıkış:
End Sub
https://drive.google.com/open?id=1rfM1jI4Mhds8_YY2bl5E-vbXMUsPvpuP
Son düzenleme: