Kodlarda Revize / Klasörden Farklı İki Sayfaya Resim Çekme

[iplikci_80]

GİRİŞ Sayfası A2 hücresine girdiğimiz sicil ile resim klasöründeki resimleri örneğin "0001 - Türk Bayrağı" şeklinde isimlendirilmiş resimleri getirebiliyorum. Mevcut kodlar aynı kalmak kaydıyla girilen sicil ile hem GİRİŞ, hem de KAPAK sayfalarına resim gelecek şekilde kodların revize edilmesi hususunda yardımlarınızı rica ediyorum.

 

[iplikci_80]

Arkadaşlar yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

KAPAK-GİRİŞ sayfasında hangi alana resim eklenecek.

Şuan ki kodlama ile I7 hücresine konumlanıyor.

 

[iplikci_80]

GİRİŞ Sayfasında K8:K13, KAPAK Sayfasında B2:C3 hücrelerine.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A2]) Is Nothing Then Exit Sub
    
    Dim S1 As Worksheet, S2 As Worksheet, Sayfa As Worksheet
    
    Set S1 = Sheets("SİCİL KARTI")
    Set S2 = Sheets("KAPAK")
        
    For Each Sayfa In Sheets(Array(S1.Name, S2.Name))
        For Each rsm In S1.DrawingObjects
            If rsm.Left > S1.[J7].Left And rsm.Top >= S1.[J7].Top Then rsm.Delete
        Next
        
        For Each rsm In S2.DrawingObjects
            If rsm.Left > S2.[B2].Left And rsm.Top >= S2.[B2].Top Then rsm.Delete
        Next
    Next
                
    For Each Sayfa In Sheets(Array(S1.Name, S2.Name))
        Select Case Sayfa.Name
            Case "KAPAK"
                gen = 150: yuk = Sayfa.[B2].Height
                ust = Sayfa.[C2].Top: sol = Sayfa.[C2].Left
            Case "SİCİL KARTI"
                gen = Sayfa.[K8:K13].Width: yuk = Sayfa.[K8:K13].Height
                ust = Sayfa.[K8].Top: sol = Sayfa.[K8].Left
        End Select
        
        ek = Evaluate("=REPT(""0"", 4 - " & Len(Target) & ")")
        
        varmi = Dir(ThisWorkbook.Path & "\" & ek & Target.Value & " - *" & ".jpg")
        
        If varmi = "" Then Exit Sub

        Set rsm = Sayfa.Shapes.AddShape(msoShapeRoundedRectangle, sol, ust, gen, yuk)
        With rsm
            .Line.Weight = 1: .Fill.Visible = msoTrue
            .Fill.UserPicture ThisWorkbook.Path & "\" & varmi
        End With
    Next
    
    ek = Empty
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[iplikci_80]

Korhan Bey ilginize teşekkür ederim. Mevcut olmayan bir sicil girdiğimizde SİCİL KARTI sayfasındaki gibi KAPAK sayfasında en son gelen resminde silinmesini sağlayacak şekilde revize edilmesi hususunda yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

Kodlardan GİRİŞ sayfasını kaldırmışsınız.

Bu sayfaya resim gelmeyecek miydi?

 

[iplikci_80]

Cevap 4 de GİRİŞ Sayfasını sehven bildirdiğim için kaldırdım. SİCİL KARTI Sayfasında K8:K13, KAPAK Sayfasında B2:C3 hücrelerine olacaktı ve mevcut olmayan bir sicil girdiğimizde SİCİL KARTI sayfasındaki gibi KAPAK sayfasında en son gelen resminde silinmesini sağlayacak şekilde revize edilmesi hususunda yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

K8:K13 konusunda emin misiniz? Zira sütun dar olduğu için resim sıkışmış gibi görünecektir.

 

[iplikci_80]

Evet. Orijinal belgede geniş.

 

[Korhan Ayhan]

#5 nolu mesajımı revize ettim.

Deneyiniz.

 

[iplikci_80]

Korhan Bey sadece mevcut olmayan bir sicil girdiğimizde SİCİL KARTI sayfasındaki gibi KAPAK sayfasında en son gelen resminde silinmesini sağlayacak şekilde revize edilmesi hususunda yardımlarınızı rica ediyorum. EK'te örnekte RESİM klasöründe 5 sicil var 7 sicil girildiğinde SİCİL KARTI sayfasında resim yok ama KAPAK sayfasındaki resim gitmiyor.

 

[Korhan Ayhan]

Bugün başım ağrıyordu. Sanırım tam odaklanamadım. Kusura bakmayın.

#5 nolu mesajımı revize ettim. Sanırım bu sefer oldu.

 

[iplikci_80]

Geçmiş olsun. Her şey için çok teşekkür ederim.