Resmi birleştirilmiş hücre boyutunda ekleme

[excellkurdu]

Arkadaşlar merhaba,
Ekteki kod resim ekliyor. fakat bir hücreye ekliyor. Resmi c39:k46 birleştirilmiş hücre alanına nasıl ekleyebiliriz?
Şimdiden teşekkür ederim

Sub Ekle_resim()
    Call resimsil
    Dim NoA As Long, i As Long
    Dim PicFile As String, PicTop As Integer, PicLeft As Integer, PicW As Integer, PicH As Integer
    NoA = Range("A" & Rows.Count).End(xlUp).Row
 
    For i = 39 To NoA
        PicFile = "C:\Dosyalarım\pestkontrol\firmalar\Sistem\_Fumigasyon\" & Range("A" & i).Text & ".jpg"
        
        If Dir(PicFile) = Empty Then
            Range("C" & i) = "Resim bulunamadı..!"
            GoTo ResumeFor:
        End If
        PicTop = Range("C" & i).Top '???????????
        PicLeft = Range("C" & i).Left '???????????
        PicW = Range("C" & i).Width '???????????
        PicH = Range("C" & i).Height '???????????
        Set MyPic = ActiveSheet.Shapes.AddPicture(PicFile, True, True, PicLeft, PicTop, PicW, PicH)  '???????????
ResumeFor:
    Next
End Sub
Sub resimsil()
    Dim Resim As Picture, Alan As Range
    Set Alan = Range("C39:C41")
    For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Alan) Is Nothing Then
            Resim.Delete
        End If
    Next
    Set Alan = Nothing
   ' MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Cengiz Demir]

Anladığım kadarı ile kod, klasörde bulunan resimleri (3 adet) döngü ile C39-C41 hücrelerine tek tek ekliyor.

Siz tek bir resimi mi c39:k46 arasına yerleştireceksiniz ?
Yoksa birden fazla resimi, birleştirilmiş alanda mı toplamak istiyorsunuz ?

İkinci seçenekse karmaşık bir kodlama gerektirir. (Zamanı olan başka bir üstad bakabilir sanırım.)
C39:K46 alanının yükseklik genişlik vb. değerine ve eklenecek resim sayısına göre,
resimlerin koordinatlarını ve boyutlarını hesaplatıp,
o alana sığacak şekilde ekletmek lazım.

İlk seçenek için Ekle_Resim makrosunu uygun şekilde düzenledim.
Makroya göre, A1 hücresine resim adını yazmalısınız.

Sub Ekle_resim()
    Call resimsil
    Dim NoA As Long, i As Long
    Dim PicFile As String, PicTop As Integer, PicLeft As Integer, PicW As Integer, PicH As Integer
    

        PicFile = "C:\Dosyalarım\pestkontrol\firmalar\Sistem\_Fumigasyon\" & Range("A1").Text & ".jpg"
        
        If Dir(PicFile) = Empty Then
            Range("C" & i) = "Resim bulunamadı..!"
            Exit Sub
        End If
        PicTop = Range("C39:K46").Top '???????????
        PicLeft = Range("C39:K46").Left '???????????
        PicW = Range("C39:K46").Width '???????????
        PicH = Range("C39:K46").Height '???????????
        Set MyPic = ActiveSheet.Shapes.AddPicture(PicFile, True, True, PicLeft, PicTop, PicW, PicH)  '???????????

End Sub

 

[excellkurdu]

Hocam Çalıştığımdan hemen bakamadım, özür dilerim.
Emeğine sağlık bütün seçenekleri yazmışsınız. Kod Gayet iyi işimi gördü.
Teşekkür ederim. allah razı olsun

 

[Cengiz Demir]

Rica ederim
Allah cümlemizden razı olsun

Hocam Çalıştığımdan hemen bakamadım, özür dilerim.
Emeğine sağlık bütün seçenekleri yazmışsınız. Kod Gayet iyi işimi gördü.
Teşekkür ederim. allah razı olsun

 

[Cengiz Demir]

Merhabalar. Burdaki kodu değiştirmeyi unutmuşum.

Range("C" & i) = "Resim bulunamadı..!" kodu

Range("C39:K46") = "Resim bulunamadı..!" olacak.

if ile end if arası resim bulunamadığı zaman devreye girip ilgili hücreye resim bulunamadı yazıyor.
Düzeltmeseydik o kodda hata verecekti.