Çözüldü Formül ile klasörden resim alma

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

nasyarx

Yeni Üye
Katılım
11 Tem 2018
Mesajlar
70
En iyi yanıt
0
Puanları
8
Yaş
38
Konum
Muş
Ad Soyad
Ensar Mansur
Selamlar,
Formül ile hücrelerdeki verilere göre klasörden resim çağırma işlemi yapılabilir mi?
 

nasyarx

Yeni Üye
Katılım
11 Tem 2018
Mesajlar
70
En iyi yanıt
0
Puanları
8
Yaş
38
Konum
Muş
Ad Soyad
Ensar Mansur
Sayın @Admin,
Örnek dosya ekledim . Klasörden okul numarasına göre düşeyara resim getirmek istiyorum.Makro kodu için yardımcı olabilir misiniz?
 

Ekli dosyalar

Admin

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,105
En iyi yanıt
3
Puanları
113
Konum
İstanbul
Web sitesi
www.excelarsivi.com
Ad Soyad
Excel Arşivi
Bunu mevcut bu makronuz çalışırken mı yapmak istiyorsunuz? :unsure:

PHP:
Sub Auto_Open()
10 For i = 2 To 150
        DoEvents
        If Not IsEmpty(Sheets("VERİLER").Cells(i, 5).Value) Then
            basla = Timer
            While (Timer - basla) < 1
                DoEvents
               Sheets("VERİLER").Range("H3").Value = Format(Time, "hh:mm:ss")
            Wend
            While (Timer - basla) < 3
                DoEvents
                Sheets("VERİLER").Range("K2").Value = Sheets("VERİLER").Cells(i, 4).Value
            Wend
        End If
    Next i
    GoTo 10
End Sub
 

nasyarx

Yeni Üye
Katılım
11 Tem 2018
Mesajlar
70
En iyi yanıt
0
Puanları
8
Yaş
38
Konum
Muş
Ad Soyad
Ensar Mansur
Evet. Mümkün mü?
 

nasyarx

Yeni Üye
Katılım
11 Tem 2018
Mesajlar
70
En iyi yanıt
0
Puanları
8
Yaş
38
Konum
Muş
Ad Soyad
Ensar Mansur
Müsaitseniz yardım edebilir misiniz?
 

Admin

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,105
En iyi yanıt
3
Puanları
113
Konum
İstanbul
Web sitesi
www.excelarsivi.com
Ad Soyad
Excel Arşivi
Merhaba, bu kodları kullanabilirsiniz.. (y)
PHP:
Sub Auto_Open()
    On Error Resume Next
    Dim foto As Shape, bak As Boolean
        For Each foto In ActiveSheet.Shapes
        If InStr(1, foto.Name, "Picture") > 0 Then
            foto.Delete
        End If
    Next foto
10 For i = 2 To 150
        DoEvents
        If Not IsEmpty(Sheets("VERİLER").Cells(i, 5).Value) Then
            basla = Timer
            While (Timer - basla) < 1
                DoEvents
               Sheets("VERİLER").Range("H3").Value = Format(Time, "hh:mm:ss")
            Wend
            DoEvents
            While (Timer - basla) < 3
                DoEvents
                Sheets("VERİLER").Range("K2").Value = Sheets("VERİLER").Cells(i, 4).Value
                DoEvents
                On Error GoTo 30
                On Error GoTo -1
                If bak = False Then
                Application.ScreenUpdating = False
                    For Each foto In ActiveSheet.Shapes
                        If InStr(1, foto.Name, "Picture") > 0 Then
                            foto.Delete
                        End If
                    Next foto
                    bak = True
                    Range("E9").Select
                    ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Sayfa1.Range("K11").Value & ".jpg").Select
                    DoEvents
40                    With Selection.ShapeRange.Line
                        .Visible = msoTrue
                        .Weight = 6
                    End With
                    DoEvents
                    With Selection.ShapeRange.Line
                        .Visible = msoTrue
                        .ForeColor.ObjectThemeColor = msoThemeColorText2
                        .ForeColor.TintAndShade = 0
                        .ForeColor.Brightness = 0
                        .Transparency = 0
                    End With
                    DoEvents
                    Selection.ShapeRange.ScaleWidth 0.835, msoFalse, msoScaleFromTopLeft
                    Selection.ShapeRange.ScaleHeight 0.835, msoFalse, msoScaleFromTopLeft
                    Selection.ShapeRange.ScaleWidth 0.8122605965, msoFalse, msoScaleFromBottomRight
                    DoEvents
                    Range("F15").Select
                    bak = False
                    Application.ScreenUpdating = True
                End If
            Wend
        End If
    Next i
    GoTo 10
30
    a = 5
        ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\yok.jpg").Select
        If a = 5 Then GoTo 40
End Sub
 

fatih

Yeni Üye
Katılım
30 Eyl 2018
Mesajlar
20
En iyi yanıt
0
Puanları
3
Yaş
30
Konum
Ankara
Ad Soyad
Fatih
Sayfaya comobobox ekledim comboboxtan isim seçtiğinde okulno ya göre klasörden resim arama yapacak çünkü aynı isimli öğrenciler var
Dosya ekte
 

Ekli dosyalar

Admin

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,105
En iyi yanıt
3
Puanları
113
Konum
İstanbul
Web sitesi
www.excelarsivi.com
Ad Soyad
Excel Arşivi
Denedim fakat resim yok hep kalıyor.
Veriler sayfasında isim ve sınıf altına o öğrencinin numarasını da getirmiştim. Resim adları okul no'ya göre çünkü..
O yüzden o bilgiye de ihtiyacımız vardı. O sebeple K11 hücresine bu formülü de yapıştırmanız gerekiyordu, o bilgiyi size aktarmadığımı fark ettim.
PHP:
=DOLAYLI(ADRES(KAÇINCI($K$2;F:F;0);2))
Sonrasında OKUL sayfasını seçin, dosyayı kaydedip kapatıp tekrar açın, istediğiniz olacaktır.. (y)
Olmazsa çalışan dosyayı da iletirim size.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt