• Merhaba Ziyaretçi,
    10 Ağustos'a Kadar VIP Paket %67 İNDİRİMLİ (bir kere öde, ömür boyu kullan)
    İndirimden yararlanmak için resme tıklayın. 👇🏻
  • Merhaba Ziyaretçi,
    YouTube sayfamıza abone olarak destek olabilirsiniz.
  • Sn. Ziyaretçi,
    PEAKUP E-Book & Makale & Videoları yayınlandı.
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

hiray

Yeni Üye
Katılım
14 Kas 2018
Mesajlar
5
En iyi yanıt
0
Puanları
3
Yaş
50
Konum
Denizli
Ad Soyad
Halil İbrahim YÜKSEL
Örnek dosya ekledim, basit bir kimlik kartı yapmak için, örnek excel dosyasındaki KART sekmesi, öğrenci ad soyad no ve sınıf bilgilerini LİSTE sekmesinden,resim alanlarındaki boşluklara da RESİM dosyasındaki vesikalıkları sırasıyla alarak kimlik kartı oluşturmak istiyorum..YARDIMCI OLURSANIZ MEMNUN OLURUM.
 

Ekli dosyalar

  • DOSYADAN RESİM ALMA.rar
    914.7 KB · Görüntüleme: 13

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,331
En iyi yanıt
11
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Versiyon
Office 365 TR+EN
Merhaba aşağıdaki kodları kullanabilirsiniz..
Kodları ilgili alanlara yapıştırdıktan sonra KART sayfasının A1 hücresine tıklayınca tüm veriler ve resimler kartlara yerleşecektir.

Bu arada, öğrenci isimleri ile fotoğrafları ve fotoğraf isimleri uyuşmayanlar var, bunları kontrol edip düzeltirsiniz. (y)

KART sayfasının kod penceresine..
PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address(0, 0) <> "A1" Then Exit Sub
    Call Resim_Ekle
End Sub
Module1 içerisine..
PHP:
Sub Resim_Ekle()
    Application.Volatile
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    ActiveSheet.DrawingObjects.Delete
    Sayfa2.Range("B:B,F:F,J:J,N:N,R:R").ClearContents
    dip = Sayfa1.Cells(Rows.Count, "A").End(3).Row
    sat = 2: sut = 3
    For i = 2 To Sayfa1.Range("A65536").End(3).Row
        For Each resim In fso.getfolder(ThisWorkbook.Path & "\resim\").Files
            foto = resim.Name
            listedekifoto = Replace(Sayfa1.Cells(i, "A").Value, "/", "") & " (" & Sayfa1.Cells(i, "B").Value & ").JPG"
            If listedekifoto = foto Then
                Set fotom = ActiveSheet.Pictures.Insert(CStr(resim))
                With fotom
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Width = Sayfa2.Range(Sayfa2.Cells(sat, sut), Sayfa2.Cells(sat + 5, sut + 1)).Width
                    .Height = Sayfa2.Range(Sayfa2.Cells(sat, sut), Sayfa2.Cells(sat + 5, sut + 1)).Height
                    .Top = Sayfa2.Rows(Sayfa2.Cells(sat, sut).Row).Top
                    .Left = Sayfa2.Columns(Sayfa2.Cells(sat, sut).Column).Left
                    .Placement = xlFreeFloating
                    Sayfa2.Cells(sat + 1, sut - 1).Value = Sayfa1.Cells(i, "C").Value
                    Sayfa2.Cells(sat + 2, sut - 1).Value = Sayfa1.Cells(i, "D").Value
                    Sayfa2.Cells(sat + 3, sut - 1).Value = Sayfa1.Cells(i, "A").Value
                    Sayfa2.Cells(sat + 4, sut - 1).Value = Sayfa1.Cells(i, "B").Value
                    sut = sut + 4
                    If sut > 19 Then
                        sut = 3
                        sat = sat + 8
                    End If
                End With
            End If
        Next resim
    Next i
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

hiray

Yeni Üye
Katılım
14 Kas 2018
Mesajlar
5
En iyi yanıt
0
Puanları
3
Yaş
50
Konum
Denizli
Ad Soyad
Halil İbrahim YÜKSEL
Öncelikle çok teşekkürler....
işlemi yapıyor ancak compile error Sub or function not defined diye hata veriyor ve sayfada herhangi bir hücreye tıklasam aynı hata penceresi açıyor,kaydedip tekrar açtığımda resim ve isimler geliyor,fakat, makrolar siliniyor,normal mi? listede düzenleme yapıp tekrar A1 hücresine basmak istedim ama olmadı...her defasında makroları kopyalayıp yapıştırmak mı gerekiyor...
 

l3oomerangg

Yeni Üye
Katılım
28 Ağu 2018
Mesajlar
14
En iyi yanıt
0
Puanları
3
Yaş
42
Konum
Sultangazi - İSTANBUL
Ad Soyad
Fatih Yanartaş
Ben denedim, bende sorun çıkmadı. Kodları yanlış bölümlere yapıştırıyor olabilirsiniz. Bu bakımdan ben kodları ilgili yerlere ekleyip dosyanızı tekrar yükledim.

Eklediğiniz kodların silinme mevzusu ise, dosyanızı kaydederken *.xlsx olarak değil, "Makro İçerebilen Excel Çalışma Kitabı(*.xlsm) olarak kaydedin. Standart excel .xls veya .xlsx uzantılı dosyalar makroları tutmazlar.

Admin beyin dediği gibi, resim isimlerinde ayırt edici bir bölüm gerekiyor. Bu da en iyi Okul No ile olur. Resim dosyalarının isimlerinde parantez içerisinde ki kısımlara Okul No yu yazarsanız tam olarak istediğiniz şekilde çalışacaktır program...

Eğer gene sorun yaşarsanız lütfen yazın. İşine karıştığım için inşallah Admin bey kızmaz :)
 

Ekli dosyalar

  • KART.xlsm
    23.6 KB · Görüntüleme: 17

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,331
En iyi yanıt
11
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Versiyon
Office 365 TR+EN
Standart excel .xls veya .xlsx uzantılı dosyalar makroları tutmazlar.
Sn. @l3oomerangg, buradaki .xls dosyaları makroları tutmaz ifadeniz yanlış bir ifadedir. xls uzantılı dosyalarda makroları kullanabilirsiniz.
Office 2007 itibari ile makro içerebilen çalışma kitabı uzantısı .xlsm hayatımıza girdin, ondan önce tüm makrolu makrosuz dosyalarımızı .xls uzantıları olarak tutardır. Bilginize.


İşine karıştığım için inşallah Admin bey kızmaz :)

Estağfurullah.. arkadaşa yardımınızdan dolayı memnun oldum. :)(y)
Anladığım kadarıyla eklesem hata alınmazdı fakat dosyayı bilerek eklemedim. İnsan bir işi kendi yapmadığı sürece onu anlayamaz.
Burada amacımız sadece al bu kodu, al bu dosyayı kullan demek değil, olabildiğince karşı tarafa işin yolunu yöntemini anlatabilmek.

Saygılar
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt