- Katılım
- 15 Ağustos 2009
- Mesajlar
- 511
- Excel Vers. ve Dili
- Excel Vers. ve Dili : Ofis 2016 Tr
- Altın Üyelik Bitiş Tarihi
- 13.09.2027
Merhabalar,
Userform üzerinden F8 e isim girince D2 ye kişinin resmini (isim değiştiğinde resim silinip yeni isme göre yeni resim gelmekte), Ayrıca F8 e ne yazılırsa yazılsın alttaki kodla F2 ye res1 isimli ve J2 ye res2 isimli resimleri ( bunlar isme göre değişmeyen iki aynı resim) getiriyorum. Ve print işlemi yapıyorum.
Fakat F8 e her girilen isimden sonra F2 ve J2 ye alınan resimler üst üste binmekte ve dosyayı şişirmekte. Sayfadan çıkıldığında veya print işlemi bittiğinde F2 ve J2 deki resimleri silecek kod nasıl olabilir?
Bilgi için teşekkürler…
Private Sub Worksheet_Change(ByVal Target As Range)
Dim res As String
Dim a As Shape
Dim D2 As Range
If Sayfa2.Range("f8") <> "" Then
Range("j2").Select
ActiveSheet.Pictures.Insert("\RESİMLER\res2.jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 40
Selection.ShapeRange.Width = 190
Selection.ShapeRange.Rotation = 0#
End If
If Sayfa2.Range("f8") <> "" Then
Range("F2").Select
ActiveSheet.Pictures.Insert("\RESİMLER\res1.jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 20
Selection.ShapeRange.Width = 140
Selection.ShapeRange.Rotation = 0#
End If
End Sub
Userform üzerinden F8 e isim girince D2 ye kişinin resmini (isim değiştiğinde resim silinip yeni isme göre yeni resim gelmekte), Ayrıca F8 e ne yazılırsa yazılsın alttaki kodla F2 ye res1 isimli ve J2 ye res2 isimli resimleri ( bunlar isme göre değişmeyen iki aynı resim) getiriyorum. Ve print işlemi yapıyorum.
Fakat F8 e her girilen isimden sonra F2 ve J2 ye alınan resimler üst üste binmekte ve dosyayı şişirmekte. Sayfadan çıkıldığında veya print işlemi bittiğinde F2 ve J2 deki resimleri silecek kod nasıl olabilir?
Bilgi için teşekkürler…
Private Sub Worksheet_Change(ByVal Target As Range)
Dim res As String
Dim a As Shape
Dim D2 As Range
If Sayfa2.Range("f8") <> "" Then
Range("j2").Select
ActiveSheet.Pictures.Insert("\RESİMLER\res2.jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 40
Selection.ShapeRange.Width = 190
Selection.ShapeRange.Rotation = 0#
End If
If Sayfa2.Range("f8") <> "" Then
Range("F2").Select
ActiveSheet.Pictures.Insert("\RESİMLER\res1.jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 20
Selection.ShapeRange.Width = 140
Selection.ShapeRange.Rotation = 0#
End If
End Sub