Klasörden Resim Çağırma Hk.

[askm]

Set Alan = Range("AS" & Target.Row) satırını
Set Alan = Range("AS8:AS" & Target.Row) şeklinde değiştirebilirsiniz. Ya da AS sütununda listeniz kaça kadar gidiyorsa ona göre Target.row kısmını değiştirerek işlem yapabilirsiniz. Yani sadece belirli bir alandaki resmi silmek için;
Set Alan = Range("AS8:AS1000") yapabilirsiniz. (AS8 ile AS1000 arasındaki resimleri siler.

 

[akcayonline]

Merhaba, Set Alan = Range("AS" & Target.Row) şeklinde bir satır göremedim, bunu yeniden eklemem mi gerekiyor acaba ? Mevcuttaki kodu ekliyorum ;

Public Function DosyaVarmi(dosyayolu As String) As Boolean
    On Error GoTo Çikis
    If Not Dir(dosyayolu, vbDirectory) = vbNullString Then DosyaVarmi = True
     
Çikis:
    On Error GoTo 0
End Function
 
'worksheette bir degisiklik oldugunda bu kisim çalisiyor
Private Sub Worksheet_Change(ByVal Target As Range)
 
'degisiklik b sutunundami olmus diye kontrol et, degilse direk olarak fonksiyondan çik
If Intersect(Target, [E1]) Is Nothing Then Exit Sub
 
'herhangi bir hata olusursa Çikis labelina git
On Error GoTo Çikis:
 
' ilk olarak yüklü olan Resimleri silelim
ActiveSheet.DrawingObjects.Delete
 
Dim ResimDosyaYolu As String
Dim Resim As Object
Dim Resim_yolu


'b deki 5 ile 12 arasindaki satirlari kontrol edip resim atamasi yapiyoruz, siz burayi isteginize göre artirabilirsiniz
'For i = 5 To 12
    'aktif sayfanin path bilgisini alip, seçilen ürün idyi sonuna ekliyoruz ve dosyayi aliyoruz
    ResimDosyaYolu = Resim_yolu & "\\orfs1\depo\Planlama\Desen_resimler\" & Range("e" & 1) & ".jpg"
 
    'dosya yok ise hataya düsmemek için asagidaki kontrolü yapiyoruz.
    If DosyaVarmi(ResimDosyaYolu) Then
         ResimDosyaYolu = Resim_yolu & "\\orfs1\depo\Planlama\Desen_resimler\" & Range("e" & 1) & ".jpg"
   Else
         ResimDosyaYolu = Resim_yolu & "\\orfs1\depo\Planlama\Desen_resimler\yok.jpg"
   End If
         
    'resmi olusturuyoruz.
     Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     'Resmi boyutlandiriyoruz
     With Range("n9:o28")
     Resim.ShapeRange.LockAspectRatio = msoFalse
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
 
'Next i
Çikis:
End Sub

 

[askm]

33. mesajımdaki kodda ilgili yeri değiştirmiştim.

 

[akcayonline]

O şekilde değişiklik yaptım fakat ekteki uyarıyı aldım.

 

[askm]

Dim ile tanımlama yapıyorsunuz. Yukarda yapmanız gereken tanımlama işlemini aşağıda yapmışsınız.
Dim ResimDosyaYolu As String
Dim Resim As Object
Dim Resim_yolu

tanımlamalarını
If Intersect(Target, [E1]) Is Nothing Then Exit Sub
satırından hemen sonraya alın.

 

[akcayonline]

Desteğiniz için çok teşekkür ederim, makro problemsiz çalışıyor. Sayfa ilk açılışta resmi yanlış bir noktaya konumluyor ama ilk değişiklikte resim olması gereken konuma doğru bir şekilde geliyor.
Aynı sayfada birde adımlı makro kaydettim. Ama burada örneğin "En" kısmına 25 değeri girmek yerine o an seçili olan hücredeki değeri seçerek makroyu çalıştırmasını istiyorum. Mümkün mü?

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("B1").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("MAL GRUBU").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("MAL GRUBU").CurrentPage = _
        "MKYL"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Klnlık").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Klnlık").CurrentPage = "12"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("En").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("En").CurrentPage = "25"
    Range("C4").Select
End Sub

 

[askm]

Activecell.value ya da hangi hücreyi seçtirecekseniz Range("B1").value gibi yazabilirsiniz.

 

[akcayonline]

Activecell.value işimi gördü, teşekkür ederim.

yeni problem farklı bir konuya girdiği için konuyu taşıdı.

Sürekli soru soruyorum ama kusura bakmayın. Şimi şöyle bir problem oldu : Bu şekilde aktif hücredeki değere göre pivottaki filtre alanından seçim yaptırıyorum fakat seçim yapınca pivot değiştiği için aktif hücredeki değer de değişiyor ve makro aslında ilk seçimdeki değere göre değil, pivot değiştikten sonraki değere göre çalışıyor

Örneğin çalıştırmadan önceki seçili hücredeki değer = A

Makro çalıştığında seçili hücreye denk gelen değer = B

Makronun çalışırken referans aldığı değer = B

Kodu ekliyorum ;

Sub Makro2()
'
' Makro2 Makro
'

'
    ActiveSheet.PivotTables("PivotTable1").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Desen").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Desen").CurrentPage = ActiveCell.Value
End Sub

 

[askm]

Kodların başına
Application.EnableEvents = False
sonuna
Application.EnableEvents = True ekleyip deneyin.

 

[akcayonline]

Aşağıdaki şekilde ekledim ama olmadı, sanırım yanlış konuma ekledim.

Sub Makro2()
'
' Makro2 Makro
'

'
Application.EnableEvents = False

    ActiveSheet.PivotTables("PivotTable1").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Desen").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Desen").CurrentPage = ActiveCell.Value
    
Application.EnableEvents = True

End Sub

 

[askm]

Örnek dosya eklerseniz yardımcı olalım.

 

[akcayonline]

Orjinal dosyanın boyutu fazla olduğu için bir kısmını gönderdim, teşekkür ederim.

 

[akcayonline]

Desteklerinizi bekliyorum, teşekkür ederim.

 

[akcayonline]

Günaydın, desteklerinizi bekliyorum. Teşekkür ederim.