Satır ve sutunun genişliğine göre foto ekle

[turgayzeynep]

C2 satır ve sutunun genişliğine göre sutunun içerisine foto eklemek için tıklayınız ibaresini makro ile yapabilirmiyim yardımcı olurmusunz

 

[ÖmerFaruk]

sanırım isteğinizi excel örnek çalışma sayfasıyla sorsanız daha kolay anlaşılacak.

 

[turgayzeynep]

Sayfayı püylaşamıyorumki

 

[Necdet]

Merhaba,
ChatGPT'ye sordum, yanıtı :

Sub ResimEkle()

    Dim ws As Worksheet
    Dim c2Genislik As Double
    Dim c2Yukseklik As Double
    Dim resimSol As Double
    Dim resimUst As Double
    Dim resim As Picture

    ' Çalışma sayfasını belirleyin
    Set ws = ThisWorkbook.Sheets("Sayfa1")  ' Sayfa adınızı uygun şekilde değiştirin

    ' C2 hücresinin genişliğini ve yüksekliğini alın
    c2Genislik = ws.Range("C2").Width
    c2Yukseklik = ws.Range("C2").Height

    ' Resmin sol ve üst pozisyonunu belirleyin (örneğin, C2 hücresinin sol üst köşesi)
    resimSol = ws.Range("C2").Left
    resimUst = ws.Range("C2").Top

    ' Resmi ekleme
    Set resim = ws.Pictures.Insert("C:\abc.jpg")  ' Resim dosya yolunu uygun şekilde değiştirin

    ' Resmi boyutlandırma
    With resim
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = c2Genislik
        .Height = c2Yukseklik
        .Top = resimUst
        .Left = resimSol
    End With
End Sub

 

[turgayzeynep]

Hocam çalışmadı

 

[turgayzeynep]

Hocam Size ulaşabileceğim bir numara verin de WhatsApp üzerinden göndereyim matbu evrakı Siz gerekli düzenleme yapıp bana atar mısınız

 

[Necdet]

Kod içindeki açıklamaları dikkate aldınız mı?

 

[turgayzeynep]

Olduğu gbi yapıştırdım

 

[Necdet]

peki bu durumda ne bekliyordunuz? sonuç normal değil mi?

Set resim = ws.Pictures.Insert("C:\abc.jpg")  ' Resim dosya yolunu uygun şekilde değiştirin

burada açıklama var, bi zahmet oradaki resmin yolunu ve adını da siz gireceksiniz, biz nerden bilelim?

 

[turgayzeynep]

Uzantıyıda değiştrdim olmadı hocam

 

[akcygt11]

Merhaba dosyayı dosya.co wetransfer.com gibi bir dosya sağlayıcısına yükleyip link paylaşabilir misiniz ?

 

[turgayzeynep]

Askeri evrak olduğu için paylaşamıyoruz kusura bakmayın

 

[turgayzeynep]

Birebir atabileceğim yer varsa oradan yardımcı olursanız sevinirim

 

[akcygt11]

bu tarz bir şey mi istiyorsunuz

İndir RESİMEKLE

Dosyayı indir RESİMEKLE

dosya.co

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub ResimEkle()

    Dim c2Genislik As Double
    Dim c2Yukseklik As Double
    Dim resimSol As Double
    Dim resimUst As Double
    Dim resim As Picture
    Dim resimDosyasi As String
    
    resimDosyasi = ResimDosyasiSec
    
    If resimDosyasi = "" Then
        MsgBox "Resim Dosyasi Seçilmedi....", vbCritical
        Exit Sub
    End If
    
    c2Genislik = Range("C2").Width
    c2Yukseklik = Range("C2").Height

    ' Resmin sol ve üst pozisyonunu belirleyin (örneğin, C2 hücresinin sol üst köşesi)
    resimSol = Range("C2").Left
    resimUst = Range("C2").Top

    ' Resmi ekleme
    Set resim = ActiveSheet.Pictures.Insert(resimDosyasi)  ' Resim dosya yolunu uygun şekilde değiştirin

    ' Resmi boyutlandırma
    With resim
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = c2Genislik
        .Height = c2Yukseklik
        .Top = resimUst
        .Left = resimSol
    End With
End Sub

Function ResimDosyasiSec() As String
 
    Dim lngCount As Long
 
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False   'True
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 2
        .Show
 
        For lngCount = 1 To .SelectedItems.Count
            ResimDosyasiSec = .SelectedItems(lngCount)
        Next lngCount
 
    End With
 
End Function

 

[turgayzeynep]

Mail adresiniz varsa gndereym

 

[turgayzeynep]

Vallahi yapamadım hocam

 

[turgayzeynep]

Olmuyor

 

[turgayzeynep]

Hocam C2 hücresine çift tıkladığım zaman resimlerime yönlendirmesini ve orada fotoğrafı seçerek C2 hücresindeki boyuta göre enine ve boyuna genişliğine göre fotoğrafı otomatikman koymasını istiyorum ama bir türlü olmadı

 

[turgayzeynep]

Size birebir ulaşabileceğim bir irtibat numarası yok mu WhatsApp üzerinden göndereyim