Enter abasınca "A1" e gidiyor veya resmi seçiyor

[DEKORrehberi.com]

ekteki dosyada resim çağırma makrosu var. bu makro olunca
Entera basınca bir alt satıra gitmiyor

resmi çağırdığı makroya gidiyor.. nasıl bir düzenleme yapılabilir..

 

[Ömer BARAN]

Merhaba.

Belgenizi tam anlamış değilim ama; İMALAT isimli sayfanın kod bölümünde yer alan Worksheet_Change kod blokundaki,
-- Range("T19").Select satırını silerek veya bu satırın sol başına TEK TIRNAK işareti ekleyerek devre dışı kalmasını sağlayın,
-- ayrıca, aynı kod blokunda yer alan T19 = "RESİM YOK" satırındaki T19'u, [T19] şeklinde köşeli parantez arasına alın.

Sanırım istediğiniz bu.
.

 

[DEKORrehberi.com]

herhangi bir hücreye birşey yazdığımda ve enter a basınca
T19 a gidiyor.

Excell in normal hali gibi emter ile bir alta geçmesini istiyorum

ve

" Range("T19").Select " hücresine resim çağırdığım için bu satırı da silemiyorum..

 

[askm]

Kodun başına If Intersect(Target, [E6]) Is Nothing Then Exit Sub şeklinde alan belirtin. Resim hangi hücre değişince aktif olmasını istiyorsanız bunu belirtin. Sayfada nerede olursanız olun kod çalışması anlamlı değil.

 

[DEKORrehberi.com]

Ya kusura bakmayın ben yapamadım herhalde

Kod aşağıda yanlış yere mi yazdım acaba

hücre içinde değişiklik yapınca

alt satıra geçmiyor..


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
Dim resim As Picture, Alan As Range
For Each resim In ActiveSheet.Pictures
If Not Intersect(resim.TopLeftCell, Alan) Is Nothing Then
resim.Delete
End If
Next
T19 = "RESİM YOK"
Set Alan = Nothing
Range("T19").Select
resimadi = LoadPicture("")
resimadi = Range("B34").Text & ".jpg"
ActiveSheet.Pictures.Insert("C:\(Kabin_Modelleri\" & resimadi).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = "190"
Selection.ShapeRange.Width = "140"
Selection.ShapeRange.Rotation = 0#


If Intersect(Target, [E6]) Is Nothing Then Exit Sub ' Buraya yazdım


Application.ScreenUpdating = True
'Sayın muygun
End Sub

 

[askm]

Kodun en başına yazın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E6]) Is Nothing Then Exit Sub ' Yalnız hangi hücrede çalışmasını istiyorsanız belirtmeniz gerek.E6 yı ona göre değiştirin.
Application.ScreenUpdating = False
On Error Resume Next
Dim resim As Picture, Alan As Range
For Each resim In ActiveSheet.Pictures
If Not Intersect(resim.TopLeftCell, Alan) Is Nothing Then
resim.Delete
End If
Next
T19 = "RESİM YOK"
Set Alan = Nothing
Range("T19").Select
resimadi = LoadPicture("")
resimadi = Range("B34").Text & ".jpg"
ActiveSheet.Pictures.Insert("C:\(Kabin_Modelleri\" & resimadi).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = "190"
Selection.ShapeRange.Width = "140"
Selection.ShapeRange.Rotation = 0#

Application.ScreenUpdating = True
'Sayın muygun
End Sub

 

[DEKORrehberi.com]

İlgili herkese teşekkür ederim..

Fakat bu seferde, resim çağırma işlemini yapmıyor..

Örnek dosya olarak gönderdim.

acaba yazılan ufak bişey resim çağırmayı engelle dimi?.

 

[askm]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b34]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
Dim resim As Picture, Alan As Range
For Each resim In ActiveSheet.Pictures
If Not Intersect(resim.TopLeftCell, Alan) Is Nothing Then
resim.Delete
End If
Next
T19 = "RESİM YOK"
Set Alan = Nothing
Range("T19").Select
resimadi = LoadPicture("")
resimadi = Range("B34").Text & ".jpg"
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\Kabin_Modelleri\" & resimadi).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = "190" 'yükseklik
Selection.ShapeRange.Width = "140" 'genişlik
Selection.ShapeRange.Rotation = 0#
' Selection.ShapeRange.Offset = -100#
Range("B36").Select 'BURAYA GİTMESİNİ İSTEDİĞİNİZ ADRESİ YAZIN
Application.ScreenUpdating = True
'Sayın muygun
End Sub