• DİKKAT

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

İki kodun birleştirilmesi

Hakan ERDOST

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
885
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kod: 
Dim kls As String
kls = "C:\SINIF_YÖNETİMİ\RESİMLER"
With Application.FileSearch
    .NewSearch
    .LookIn = kls
    .Filename = ComboBox1 & ".jpg"
    .SearchSubFolders = True
    .Execute
    If .FoundFiles.Count > 0 Then
        Image1.Picture = LoadPicture(.FoundFiles(1))
    End If
End With
Bu resim çağırma kodumuz, ComboBox cahnge olayına yazılı,
Bu da verileri çektiğim kod. aynı şekilde ComboBox change olayına yazılı..
Kod: 
Private Sub ComboBox1_Change()

Sheets("VERİ").Visible = True
With Sheets("VERİ")
For Each bul In .Range("C2:C" & Sheets("VERİ").Range("A65536").End(3).Row)
If CStr(bul.Value) = CStr(ComboBox1.Value) Then


Label21.Caption = bul.Offset(0, 28).Value
Label22.Caption = bul.Offset(0, 29).Value
Label23.Caption = bul.Offset(0, 30).Value
Label24.Caption = bul.Offset(0, 31).Value
Label25.Caption = bul.Offset(0, 32).Value
Label26.Caption = bul.Offset(0, 34).Value
Label29.Caption = bul.Offset(0, 13).Value
Label30.Caption = bul.Offset(0, 14).Value
Label9.Caption = bul.Offset(0, 37).Value
Label10.Caption = bul.Offset(0, 38).Value
Label11.Caption = bul.Offset(0, 39).Value
Label12.Caption = bul.Offset(0, 40).Value
Label13.Caption = bul.Offset(0, 41).Value
Label14.Caption = bul.Offset(0, 43).Value
Label37.Caption = bul.Offset(0, 0).Value
Label38.Caption = bul.Offset(0, 6).Value
Label39.Caption = bul.Offset(0, 7).Value
Label40.Caption = bul.Offset(0, 8).Value
Label41.Caption = bul.Offset(0, 9).Value
Label47.Caption = bul.Offset(0, 10).Value
Label48.Caption = bul.Offset(0, 11).Value
Label49.Caption = bul.Offset(0, 12).Value
Label50.Caption = bul.Offset(0, 16).Value
Label51.Caption = bul.Offset(0, 18).Value
Label57.Caption = bul.Offset(0, 20).Value
Label58.Caption = bul.Offset(0, 22).Value
Label59.Caption = bul.Offset(0, 23).Value
Label60.Caption = bul.Offset(0, 24).Value
Label61.Caption = bul.Offset(0, 26).Value
Label70.Caption = bul.Offset(0, 5).Value
Label72.Caption = bul.Offset(0, -1).Value
Label75.Caption = bul.Offset(0, 2).Value

End If
Next bul
End With

Sheets("VERİ").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub
İki kodu birleştirirken hata verdi sürekli.
 
Resim alınan kod nerede.
Kod: 
Sub XXX()
Dim kls As String
kls = "C:\SINIF_YÖNETİMİ\RESİMLER"
With Application.FileSearch
    .NewSearch
    .LookIn = kls
    .Filename = ComboBox1 & ".jpg"
    .SearchSubFolders = True
    .Execute
    If .FoundFiles.Count > 0 Then
        Image1.Picture = LoadPicture(.FoundFiles(1))
    End If
End With
End Sub
Private Sub ComboBox1_Change()
[COLOR="Red"]Call XXX[/COLOR]
..Kodlar
End Sub
Yapınca olmuyormu?
 
vardar07' Alıntı:
Resim alınan kod nerede.
Kod: 
Sub XXX()
Dim kls As String
kls = "C:\SINIF_YÖNETİMİ\RESİMLER"
With Application.FileSearch
    .NewSearch
    .LookIn = kls
    .Filename = ComboBox1 & ".jpg"
    .SearchSubFolders = True
    .Execute
    If .FoundFiles.Count > 0 Then
        Image1.Picture = LoadPicture(.FoundFiles(1))
    End If
End With
End Sub
Private Sub ComboBox1_Change()
[COLOR="Red"]Call XXX[/COLOR]
..Kodlar
End Sub
Yapınca olmuyormu?
Genişletmek için tıkla ...

Her iki kodda ComboBox Change olayında çalışıyor farklı dosyalarda. Ancak ben veri aldığım koda (ki ikinci kod) bu resim çekme kodun eklemeye çalıştım. Ancak olmadı hata verdi. Yani verileri aldığım kodları bozmadan resim de forma almak istiyorum....Uğraşıyorum daha doğrusu :))))))
 
Bende buna benzer bir dosya kullanıyorum. Benim tüm dosya ve resimler aynı klasör içinde Resim ismindeki klasördeki resimleri alıyorum. Sizin Sizin combobox ve resim alma kodlarınız ayrı ayrı Dosyalarda ise onu bilmiyorum.
Kod: 
Private Sub ComboBox1_Click()
On Error Resume Next
Image1.Picture = LoadPicture("")
 Image1.Picture = LoadPicture("")
 Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Resim\" & ComboBox1.Text & ".jpg")
 Image1.PictureSizeMode = fmPictureSizeModeZoom
Call Toplam
Call kalan1
End Sub
 
Kod: 
Call Toplam
Call kalan1
Satırlarında hata verdi ancak silince sorun kalmadı.Bir sorum daha olacak ancak ...:).İki adet combobox ile veri aldığım bir formum var.Bu formda 1 nolu combadaki öğrenci seçildiğinde o öğrenci ile yapılan görüşmelerin sayfasına gidiyor yapılan görüşme nosunu combo2 ikiye çekiyor. Buraya kadar sorun yok ancak ilgili nolu görüşmenin satırın sağından veri alamıyorum. Örneğin Ahmetin 2. görüşmesinin tarihi konusu vs.
Kodalar aşağıda;
Kod: 
Dim DİZİB As New Collection, HÜCRE As Range, VERİ As Variant

Private Sub ComboBox1_Change()
Dim DİZİB As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
     Sheets("VELİ_GÖRÜŞME").Select
    For Each HÜCRE In Range("C2:C" & Range("A65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 Then
        DİZİB.Add HÜCRE.Offset(0, -1).Value, CStr(HÜCRE.Offset(0, -1).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox2.Clear
    
    For Each VERİ In DİZİB
        ComboBox2.AddItem VERİ
    Next
    
With Sheets("VELİ_GÖRÜŞME")
For Each bul In .Range("C2:C" & Sheets("VELİ_GÖRÜŞME").Range("A65536").End(3).Row)
If CStr(bul.Value) = CStr(ComboBox1.Value) Then


Label11.Caption = bul.Offset(0, 0).Value
Label12.Caption = bul.Offset(0, 1).Value
Label13.Caption = bul.Offset(0, 2).Value
Label14.Caption = bul.Offset(0, 3).Value
Label15.Caption = bul.Offset(0, 4).Value
Label16.Caption = bul.Offset(0, 5).Value
Label17.Caption = bul.Offset(0, 6).Value
Label18.Caption = bul.Offset(0, 7).Value
Label20.Caption = bul.Offset(0, -1).Value
TextBox1 = bul.Offset(0, 8).Value
TextBox2 = bul.Offset(0, 9).Value

End If
Next bul
End With
    
    
    
    
    
End Sub

Private Sub UserForm_Initialize()
Dim Say, i As Integer
 Dim DİZİA As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    Sheets("VELİ_GÖRÜŞME").Select
    For Each HÜCRE In Range("C2:C" & Range("A65536").End(3).Row)
        DİZİA.Add HÜCRE.Value, CStr(HÜCRE.Value)
    Next
    
    On Error GoTo 0
    
    For Each VERİ In DİZİA
        ComboBox1.AddItem VERİ
    Next
        
    End Sub
 
Son düzenleme:
Örnek ekleme şansınız varsa daha net sonuç alırız gibime geliyor.Labellere alıyor gibi sanki. Label yada Textboxa alacaksanız örnek label olursa LabelX.caption= Sheets("VELİ_GÖRÜŞME").Cells(bul.row,"D") kırmızılı yer veri alınacak sütun adı.
 
Şöyle izah edeyim; Veri almada sorun yok ancak birinci combodan Ahmeti seçtiğimde diyelim ki Ahmet ile 3 görüşme yapılmış.Bu görüşme no'da combo2 ye çekiyorum ama Ahmet'in ilk görüşmesindeki verileri çekiyor. 2. veya 3. görüşmeyi seçtiğimde veriler değişmiyor. Örnek dosyada çok fazla veri var ve öğrenci bilgileri olduğundan ekleyemiyorum.
 
Farklı kaydet yapıp gerçek verilerin yerine birkaç satır eklerseniz daha iyi olur. Yada bir sürü label yada textboxla uğraşmadan listview le halledilebilir. Böylece bir seferde tüm görüşmeleride görmüş olursunuz.
 
Dosya ekte...
 

Ekli dosyalar

Userform19 içindeki değişiklikleri inceleyiniz.
 

Ekli dosyalar

Sayın vardar07 teşekkürler.
 
Rica ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst