• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

KLASÖRDEN HÜCREYE RESİM ÇEKME

A

avare1907

Altın Üye
Katılım
27 Ekim 2016
Mesajlar
89
Excel Vers. ve Dili
excel 2010 türkçe
Değerli üstad'lar bir konuda desteğinizi rica edeceğim eklediğim bir form var sizden ricam formun başındaki açılır listedeki kırmızı renk ile işaretlediğim parça hücredeki parçanın resmi masaüstündeki kalsörden resim hücresine gelsin ve hücre boyutuna göre olsun hücre boyutunu sonra kendim ayarlayacağım,

desteğiniz için şimdiden teşekkürlerimi sunuyorum saygılarımla.
 

Ekli dosyalar

Sana kendi yaptığım programı atayım mı? DRİVE LİNKİ Burada kurulum mevcut yapmak istediğin excel dosyasını seçiyorsun. Sonra resim klasörünü seçiyorsun. Sonra Excelin içindeki hangi sütun ile senin resim isimlerin eşleşiyor onu seçiyorsun sonra da resimleri hangi sütuna eklemek istiyorsun onu seçiyorsun. Genişlik ve yüksekliği de ayarlamak istersen ayarlarsın. anlamadığın bir yer olursa tekrar yazarsın
 
Bir modüle yapıştırın. Seçili hücreye resim eklemek için makroyu çalıştırın.
Ancak seçtiğiniz resim ve hücrenin en boy oranı eşit olmalı. Yoksa görsel açıdan güzel gözükmez.
Kolay gelsin.

Kod: 
Option Explicit
Sub resimekle()

Dim sPicture As String, pic As Picture
Dim Target As Range
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)

With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Offset(0, 0).MergeArea.Height
.Width = ActiveCell.Offset(0, 0).MergeArea.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
End Sub
 
Son düzenleme:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim resimAdi As String
    Dim resimYolu As String
    Dim eklenenResim As Object
    Dim hedefHücre As Range
    Dim birlesikAlan As Range
   
    ' Değişiklik M4 hücresinde mi oldu?
    If Not Intersect(Target, Me.Range("M4")) Is Nothing Then
        ' Eski resmi kaldır
        On Error Resume Next
        Me.Pictures.Delete
        On Error GoTo 0
       
        ' Resim adını al
        resimAdi = Me.Range("M4").Value
       
        ' Resim yolunu oluştur
        resimYolu = Environ("USERPROFILE") & "\Desktop\Deneme\" & resimAdi & ".png"
       
        ' Hedef hücreyi tanımla (birleştirilmiş hücre)
        Set hedefHücre = Me.Range("A13")
        Set birlesikAlan = hedefHücre.MergeArea ' Birleştirilmiş alan
       
        ' Eğer resim varsa ekle
        On Error Resume Next
        Set eklenenResim = Me.Pictures.Insert(resimYolu)
        On Error GoTo 0
       
        If Not eklenenResim Is Nothing Then
            With eklenenResim
                ' Resmin sol üst köşesini birleştirilmiş hücrenin sol üst köşesine hizala
                .Left = birlesikAlan.Left
                .Top = birlesikAlan.Top
                ' Resmi birleştirilmiş hücrenin boyutlarına göre ayarla
                .Width = birlesikAlan.Width
                .Height = birlesikAlan.Height
                .Placement = xlMoveAndSize ' Resmin hücreyle hareket etmesini ve boyutlanmasını sağlar
            End With
        Else
            MsgBox "Resim bulunamadı: " & resimYolu, vbExclamation
        End If
    End If
End Sub
Kodu VBA açarak sol taraftaki 1. OP. adlı çalışma sayfasına çift tıklayarak açılan kod modülüne yapıştırın. Klasörün yolu ve resim uzantınızı (jpg vb) kendinize göre uyarlayınız.
 
Hakan ERDOST' Alıntı:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim resimAdi As String
    Dim resimYolu As String
    Dim eklenenResim As Object
    Dim hedefHücre As Range
    Dim birlesikAlan As Range
  
    ' Değişiklik M4 hücresinde mi oldu?
    If Not Intersect(Target, Me.Range("M4")) Is Nothing Then
        ' Eski resmi kaldır
        On Error Resume Next
        Me.Pictures.Delete
        On Error GoTo 0
      
        ' Resim adını al
        resimAdi = Me.Range("M4").Value
      
        ' Resim yolunu oluştur
        resimYolu = Environ("USERPROFILE") & "\Desktop\Deneme\" & resimAdi & ".png"
      
        ' Hedef hücreyi tanımla (birleştirilmiş hücre)
        Set hedefHücre = Me.Range("A13")
        Set birlesikAlan = hedefHücre.MergeArea ' Birleştirilmiş alan
      
        ' Eğer resim varsa ekle
        On Error Resume Next
        Set eklenenResim = Me.Pictures.Insert(resimYolu)
        On Error GoTo 0
      
        If Not eklenenResim Is Nothing Then
            With eklenenResim
                ' Resmin sol üst köşesini birleştirilmiş hücrenin sol üst köşesine hizala
                .Left = birlesikAlan.Left
                .Top = birlesikAlan.Top
                ' Resmi birleştirilmiş hücrenin boyutlarına göre ayarla
                .Width = birlesikAlan.Width
                .Height = birlesikAlan.Height
                .Placement = xlMoveAndSize ' Resmin hücreyle hareket etmesini ve boyutlanmasını sağlar
            End With
        Else
            MsgBox "Resim bulunamadı: " & resimYolu, vbExclamation
        End If
    End If
End Sub
Kodu VBA açarak sol taraftaki 1. OP. adlı çalışma sayfasına çift tıklayarak açılan kod modülüne yapıştırın. Klasörün yolu ve resim uzantınızı (jpg vb) kendinize göre uyarlayınız.
Genişletmek için tıkla ...

öncelikle talebimi dikkate alıp yardımcı olmaya çalışan herkese teşekkürlerimi sunuyorum,

üstad ben kodu yapıştırdığımda bir hata yapıyorum sanırım daha doğrusu resmi çekeceği klasörün yolunu yanlış yeremi yapıştırıyorum aşağıdaki gibi bir hata veriyor henüz başarılı olamadım aydınlatırsan çok memnun olurum saygılarımla,


255730
 
Evet dosya yolunuz yanlış.
Kod: 
 resimYolu = Environ("USERPROFILE") & "\Desktop\Deneme\" & resimAdi & ".png"
Burada değişiklik yapacaksınız.
 
Hakan ERDOST' Alıntı:
Evet dosya yolunuz yanlış.
Kod: 
 resimYolu = Environ("USERPROFILE") & "\Desktop\Deneme\" & resimAdi & ".png"
Burada değişiklik yapacaksınız.
Genişletmek için tıkla ...
Hocam emeğinize sağlık, müsaade ederseniz bende kullanmak isterim. Dosya yolu
resimYolu = Environ("C:\Users\muratgunay48") & "\Desktop\test\" & resimAdi & ".jpg"
Şeklinde değil mi?
 
Hakan ERDOST' Alıntı:
Evet dosya yolunuz yanlış.
Kod: 
 resimYolu = Environ("USERPROFILE") & "\Desktop\Deneme\" & resimAdi & ".png"
Burada değişiklik yapacaksınız.
Genişletmek için tıkla ...

Üstad ben masaüstünde klasörün içinde resimlerim var oradaki dosya yolunu yapıştırdım yanlış birşey mi yapıyorum 2. resimdeki hatayı alıyorum
saygılar,

255732


255733
 
resimYolu = Environ("USERPROFILE") & "\Desktop\PARÇA RESİMLERİ\" & resimAdi & ".jpg"
.jpg dosya uzantısını resim türünüze göre değiştirebilirsiniz.
 
Rica ederim. Kolay gelsin.
 
muratgunay48' Alıntı:
Hocam çok özür dilerim vaktinizi alıyorum. Bende neden olmadı acaba. Resim boyutunu ayarlamadığım için mi acaba?
Ekli dosyayı görüntüle 255743
Genişletmek için tıkla ...
Kodunuzun tamamını atarsanız daha anlaşılır olur. Şöyle ki; buradaki resimYolu kullanıcı profilinize erişip oradan belirtilen yoldaki resimAdi değişkenini alıp uzantı ile birleştiriyor. Siz de resimAdi değişkeni var mı? Bunu kodun bu haliyle anlamak mümkün değil.
 
Hakan ERDOST' Alıntı:
Kodunuzun tamamını atarsanız daha anlaşılır olur. Şöyle ki; buradaki resimYolu kullanıcı profilinize erişip oradan belirtilen yoldaki resimAdi değişkenini alıp uzantı ile birleştiriyor. Siz de resimAdi değişkeni var mı? Bunu kodun bu haliyle anlamak mümkün değil.
Genişletmek için tıkla ...
Hocam geç cevap yazmamı lütfen saygısızlık olarak almayın lütfen, neticede bizler için uğraşıyorsunuz. Ben gece çalışıyorum, gündüz uyuyorum. Size dosyayı atayım. Daha iyi olur sanırım.
Teşekkür ederim.
Saygılarımla.
 

Ekli dosyalar

Kodunuz modülde. Modüldeki kod çağrılmadan çalışmaz. Kodunuzu resim sayfasının kod bölümüne eklerseniz çalışır. Çalışmanız ekte.Kolay gelsin.
 

Ekli dosyalar

Hakan ERDOST' Alıntı:
Kodunuz modülde. Modüldeki kod çağrılmadan çalışmaz. Kodunuzu resim sayfasının kod bölümüne eklerseniz çalışır. Çalışmanız ekte. Kolay gelsin.
Genişletmek için tıkla ...
Anladım hocam. Sayfada olması gerektiğini düşünemedim. Çok teşekkür ederim. Elinize emeğinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst