• DİKKAT

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

Userform İçin Kod Talebi

A

alptun20

Katılım
10 Eylül 2009
Mesajlar
288
Excel Vers. ve Dili
2003 Türkçe
Bir sayfada oluşturduğum iki Form için kod lazım. Elinde hazır olan varsa yardımcı olursa sevinirim..
Saygılarımla..
 

Ekli dosyalar

alptun20' Alıntı:
Bir sayfada oluşturduğum iki Form için kod lazım. Elinde hazır olan varsa yardımcı olursa sevinirim..
Saygılarımla..
Genişletmek için tıkla ...

merhaba syn: alptun20

Veri Sayfasının Userform'una ( Userform1 ) kod bölümüne
Kod: 
Private Sub CommandButton1_Click()
[COLOR="Red"]If ComboBox1.Text = Empty Then MsgBox "A Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox2.Text = Empty Then MsgBox "B Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]
If TextBox1.Text = Empty Then MsgBox "C Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox2.Text = Empty Then MsgBox "D Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
[COLOR="red"]If ComboBox3.Text = Empty Then MsgBox "E Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]
If TextBox3.Text = Empty Then MsgBox "F Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
[COLOR="red"]If ComboBox4.Text = Empty Then MsgBox "G Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox5.Text = Empty Then MsgBox "H Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox6.Text = Empty Then MsgBox "I Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox7.Text = Empty Then MsgBox "J Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox8.Text = Empty Then MsgBox "K Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox9.Text = Empty Then MsgBox "L Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox10.Text = Empty Then MsgBox "M Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox11.Text = Empty Then MsgBox "N Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox12.Text = Empty Then MsgBox "O Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]If TextBox4.Text = Empty Then MsgBox "P Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox5.Text = Empty Then MsgBox "Q Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox6.Text = Empty Then MsgBox "R Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox7.Text = Empty Then MsgBox "S Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox8.Text = Empty Then MsgBox "T Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox9.Text = Empty Then MsgBox "U Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox10.Text = Empty Then MsgBox "V Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox11.Text = Empty Then MsgBox "W Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox12.Text = Empty Then MsgBox "X Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox13.Text = Empty Then MsgBox "Y Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox14.Text = Empty Then MsgBox "Z Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox15.Text = Empty Then MsgBox "AA Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox16.Text = Empty Then MsgBox "AB Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox17.Text = Empty Then MsgBox "AC Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox18.Text = Empty Then MsgBox "AD Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox19.Text = Empty Then MsgBox "AE Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox20.Text = Empty Then MsgBox "AF Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox21.Text = Empty Then MsgBox "AG Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox22.Text = Empty Then MsgBox "AH Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox23.Text = Empty Then MsgBox "AI Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
[COLOR="red"]If ComboBox13.Text = Empty Then MsgBox "AJ Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox14.Text = Empty Then MsgBox "AK Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox15.Text = Empty Then MsgBox "AL Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox16.Text = Empty Then MsgBox "AM Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox17.Text = Empty Then MsgBox "AN Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox18.Text = Empty Then MsgBox "AO Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]If TextBox24.Text = Empty Then MsgBox "AP Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
Son_Dolu_Satir = Sheets("veri").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
[COLOR="red"]Sheets("veri").Range("A" & Bos_Satir).Value = ComboBox1.Text
Sheets("veri").Range("B" & Bos_Satir).Value = ComboBox2.Text[/COLOR]Sheets("veri").Range("C" & Bos_Satir).Value = TextBox1.Text
Sheets("veri").Range("D" & Bos_Satir).Value = TextBox2.Text
[COLOR="red"]Sheets("veri").Range("E" & Bos_Satir).Value = ComboBox3.Text[/COLOR]
Sheets("veri").Range("F" & Bos_Satir).Value = TextBox3.Text
[COLOR="red"]Sheets("veri").Range("G" & Bos_Satir).Value = ComboBox4.Text
Sheets("veri").Range("H" & Bos_Satir).Value = ComboBox5.Text
Sheets("veri").Range("I" & Bos_Satir).Value = ComboBox6.Text
Sheets("veri").Range("J" & Bos_Satir).Value = ComboBox7.Text
Sheets("veri").Range("K" & Bos_Satir).Value = ComboBox8.Text
Sheets("veri").Range("L" & Bos_Satir).Value = ComboBox9.Text
Sheets("veri").Range("M" & Bos_Satir).Value = ComboBox10.Text
Sheets("veri").Range("N" & Bos_Satir).Value = ComboBox11.Text
Sheets("veri").Range("O" & Bos_Satir).Value = ComboBox12.Text[/COLOR]Sheets("veri").Range("P" & Bos_Satir).Value = TextBox4.Text
Sheets("veri").Range("Q" & Bos_Satir).Value = TextBox5.Text
Sheets("veri").Range("R" & Bos_Satir).Value = TextBox6.Text
Sheets("veri").Range("S" & Bos_Satir).Value = TextBox7.Text
Sheets("veri").Range("T" & Bos_Satir).Value = TextBox8.Text
Sheets("veri").Range("U" & Bos_Satir).Value = TextBox9.Text
Sheets("veri").Range("V" & Bos_Satir).Value = TextBox10.Text
Sheets("veri").Range("W" & Bos_Satir).Value = TextBox11.Text
Sheets("veri").Range("X" & Bos_Satir).Value = TextBox12.Text
Sheets("veri").Range("Y" & Bos_Satir).Value = TextBox13.Text
Sheets("veri").Range("Z" & Bos_Satir).Value = TextBox14.Text
Sheets("veri").Range("AA" & Bos_Satir).Value = TextBox15.Text
Sheets("veri").Range("AB" & Bos_Satir).Value = TextBox16.Text
Sheets("veri").Range("AC" & Bos_Satir).Value = TextBox17.Text
Sheets("veri").Range("AD" & Bos_Satir).Value = TextBox18.Text
Sheets("veri").Range("AE" & Bos_Satir).Value = TextBox19.Text
Sheets("veri").Range("AF" & Bos_Satir).Value = TextBox20.Text
Sheets("veri").Range("AG" & Bos_Satir).Value = TextBox21.Text
Sheets("veri").Range("AH" & Bos_Satir).Value = TextBox22.Text
Sheets("veri").Range("AI" & Bos_Satir).Value = TextBox23.Text
[COLOR="red"]Sheets("veri").Range("AJ" & Bos_Satir).Value = ComboBox13.Text
Sheets("veri").Range("AK" & Bos_Satir).Value = ComboBox14.Text
Sheets("veri").Range("AL" & Bos_Satir).Value = ComboBox15.Text
Sheets("veri").Range("AM" & Bos_Satir).Value = ComboBox16.Text
Sheets("veri").Range("AN" & Bos_Satir).Value = ComboBox17.Text
Sheets("veri").Range("AO" & Bos_Satir).Value = ComboBox18.Text[/COLOR]Sheets("veri").Range("AP" & Bos_Satir).Value = TextBox24.Text
MsgBox "Veri Sayfasına kayıt Yapıldı", , "www.excel.web.tr"
End Sub
bu kodu
Şahıs Sayfasının Userform'una ( Userform2 ) Kod Bölümüne
Kod: 
Private Sub ComboBox7_Change()

End Sub

Private Sub CommandButton1_Click()
If TextBox1.Text = Empty Then MsgBox "A Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
[COLOR="red"]If ComboBox1.Text = Empty Then MsgBox "B Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]If TextBox2.Text = Empty Then MsgBox "C Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox3.Text = Empty Then MsgBox "D Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox4.Text = Empty Then MsgBox "E Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox5.Text = Empty Then MsgBox "F Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox6.Text = Empty Then MsgBox "G Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox7.Text = Empty Then MsgBox "H Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox8.Text = Empty Then MsgBox "I Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox9.Text = Empty Then MsgBox "J Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox10.Text = Empty Then MsgBox "K Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox11.Text = Empty Then MsgBox "L Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox12.Text = Empty Then MsgBox "M Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
[COLOR="red"]If ComboBox2.Text = Empty Then MsgBox "N Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox3.Text = Empty Then MsgBox "O Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox4.Text = Empty Then MsgBox "P Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox5.Text = Empty Then MsgBox "Q Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]If TextBox12.Text = Empty Then MsgBox "R Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If ComboBox6.Text = Empty Then MsgBox "S Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox14.Text = Empty Then MsgBox "T Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox15.Text = Empty Then MsgBox "U Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
If TextBox16.Text = Empty Then MsgBox "V Değeri Giriniz.", , "www.excel.web.tr": Exit Sub
[COLOR="red"]If ComboBox7.Text = Empty Then MsgBox "W Değeri Giriniz.", , "www.excel.web.tr": Exit Sub[/COLOR]
Son_Dolu_Satir = Sheets("Şahıs").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Şahıs").Range("A" & Bos_Satir).Value = TextBox1.Text
[COLOR="red"]Sheets("Şahıs").Range("B" & Bos_Satir).Value = ComboBox1.Text[/COLOR]
Sheets("Şahıs").Range("C" & Bos_Satir).Value = TextBox2.Text
Sheets("Şahıs").Range("D" & Bos_Satir).Value = TextBox3.Text
Sheets("Şahıs").Range("E" & Bos_Satir).Value = TextBox4.Text
Sheets("Şahıs").Range("F" & Bos_Satir).Value = TextBox5.Text
Sheets("Şahıs").Range("G" & Bos_Satir).Value = TextBox6.Text
Sheets("Şahıs").Range("H" & Bos_Satir).Value = TextBox7.Text
Sheets("Şahıs").Range("I" & Bos_Satir).Value = TextBox8.Text
Sheets("Şahıs").Range("J" & Bos_Satir).Value = TextBox9.Text
Sheets("Şahıs").Range("K" & Bos_Satir).Value = TextBox10.Text
Sheets("Şahıs").Range("L" & Bos_Satir).Value = TextBox11.Text
Sheets("Şahıs").Range("M" & Bos_Satir).Value = TextBox12.Text
[COLOR="red"]Sheets("Şahıs").Range("N" & Bos_Satir).Value = ComboBox2.Text
Sheets("Şahıs").Range("O" & Bos_Satir).Value = ComboBox3.Text
Sheets("Şahıs").Range("P" & Bos_Satir).Value = ComboBox4.Text
Sheets("Şahıs").Range("Q" & Bos_Satir).Value = ComboBox5.Text[/COLOR]Sheets("Şahıs").Range("R" & Bos_Satir).Value = TextBox12.Text
[COLOR="red"]Sheets("Şahıs").Range("S" & Bos_Satir).Value = ComboBox6.Text[/COLOR]Sheets("Şahıs").Range("T" & Bos_Satir).Value = TextBox14.Text
Sheets("Şahıs").Range("U" & Bos_Satir).Value = TextBox15.Text
Sheets("Şahıs").Range("V" & Bos_Satir).Value = TextBox16.Text
[COLOR="red"]Sheets("Şahıs").Range("W" & Bos_Satir).Value = ComboBox7.Text[/COLOR]
MsgBox "Şahıs Sayfasına Kayıt Yapıldı", , "www.excel.web.tr"
End Sub
bu kodu yapıştırınız
 

Ekli dosyalar

Son düzenleme:
teşekkûrler acaba comboların başvuracağı sütunlar kodun neresinde belirtiliyor
 
İhsan Bey Anlatamadım galiba, Comboların başvurucağı sütunu sormuştum. (veriyi aktaracağı sütun değil)
 
Dosyanız ektedir.
İpucu:Properties'ten nesnelerin tag özelliklerine bakınız.
Kod: 
Private Sub CommandButton1_Click()
Dim sat As Long, nesne As Control
sat = Cells(65536, "A").End(xlUp).Row + 1
For Each nesne In Me.Controls
    If nesne.Tag <> "" Then Cells(sat, nesne.Tag).Value = nesne.Value & "-Evren - " & sat
Next
End Sub

Private Sub UserForm_Initialize()
Dim nesne As Control, sat As Long
For Each nesne In Me.Controls

    If TypeName(nesne) = "ComboBox" And nesne.Tag <> "" Then
        sat = Sheets("Veri").Cells(65536, nesne.Tag).End(xlUp).Row
        nesne.RowSource = "Veri!" & nesne.Tag & "2:" & nesne.Tag & sat
        nesne.ListIndex = 0
    End If
Next
End Sub
 

Ekli dosyalar

Hocam süpersiniz.birde benim şu ekteki dosyaya bir baksanız.kodları yazmaya çalıştım iki gündür kafa patlattım fakat kopyalayıp yapıştıracağına kopyalanların tamamı siliniyor.yardımlarınız şimdiden teşekkür ederim.
 

Ekli dosyalar

kemalist' Alıntı:
Hocam süpersiniz.birde benim şu ekteki dosyaya bir baksanız.kodları yazmaya çalıştım iki gündür kafa patlattım fakat kopyalayıp yapıştıracağına kopyalanların tamamı siliniyor.yardımlarınız şimdiden teşekkür ederim.
Genişletmek için tıkla ...

Tamamda soruyu öyle bir soruyorsunuz ki yani çözmek için bir gazete alıp bulmaca çözsem daha iyi olur.
Belirlenmiş hücre nersedir?
Hangi hücre aralığı kesilecek hangi hücreye yapıştırılıcak
Mesela demelisiniz C2:G:2 aralığındaki hücre kesilip şu sayfada B3 hücresinden itibaren yapıştırılacak.
Bu durumda bir şey yapamam.Soruyu anlamadım.:cool:
 
evren gizlen' Alıntı:
tamamda soruyu öyle bir soruyorsunuz ki yani çözmek için bir gazete alıp bulmaca çözsem daha iyi olur.
Belirlenmiş hücre nersedir?
Hangi hücre aralığı kesilecek hangi hücreye yapıştırılıcak
mesela demelisiniz c2:g:2 aralığındaki hücre kesilip şu sayfada b3 hücresinden itibaren yapıştırılacak.
Bu durumda bir şey yapamam.soruyu anlamadım.:cool:
Genişletmek için tıkla ...

"aa" sayfasında g3:gm3 arasındaki hücre kesilip .("f3")e yapıştırılacak
"bb" sayfasında ("g4:gm4").arasındaki hücre kesilip ("f4") e yapıştırılacak
"cc" sayfasında("l4:gr4"). Arasındaki hücre kesilip ("k4") e yapıştırılacak
"dd" sayfasında ("k4:m4"). Arasındaki hücre kesilip ("j4") e yapıştırılacak
"ee" sayfasında ("f3:u3"). Arasındaki hücre kesilip ("e3") e yapıştırılacak FAKAT YAPIŞTIRILANLAR KAYBOLMAYACAK
umarım sorumu anlatabilmişimdir.aynısı buton kodunun içindede var
ilginiz için teşekkür ederim.
 
Dosyanız ektedir.:cool:
Kod: 
Private Sub CommandButton2_Click() 'KES YAPIŞTIR
Application.ScreenUpdating = False
Sheets("AA").Select
ActiveSheet.Range("G3:GM3").Cut
ActiveSheet.Range("F3").Select
ActiveSheet.Paste
Sheets("BB").Select
ActiveSheet.Range("G4:GM4").Cut
ActiveSheet.Range("F4").Select
ActiveSheet.Paste
Sheets("CC").Select
ActiveSheet.Range("L4:GR4").Cut
ActiveSheet.Range("K4").Select
ActiveSheet.Paste
Sheets("DD").Select
ActiveSheet.Range("K4:M4").Cut
ActiveSheet.Range("J4").Select
ActiveSheet.Paste
Sheets("EE").Select
ActiveSheet.Range("F3:U3").Cut
ActiveSheet.Range("E3").Select
ActiveSheet.Paste
Sheets("ANA SAYFA").Select
Application.ScreenUpdating = True
MsgBox "işlem tamam" & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

ben yine anlatamadım galiba , ben combolar ile bir sütunda belirlenen verilerin girilmesini istiyorum. Bildiğim kadarı ile rowsource ile yapılıyordu. Boş olan sütunlar kullanılabilir.
 
alptun20' Alıntı:
ben yine anlatamadım galiba , ben combolar ile bir sütunda belirlenen verilerin girilmesini istiyorum. Bildiğim kadarı ile rowsource ile yapılıyordu. Boş olan sütunlar kullanılabilir.
Genişletmek için tıkla ...
Sizin sütunlarınızda hiç veri yok ki
Ayrıca comboboxlar için rowsource ile veriler alınabiliyor ama textboxlarınızda var.Onlar ne olacak?
Neyse halledederiz.Aslında 5-10 satır veri girip yollasaydınız daha iyi olurdu.Boş görünce sandım ki oraya veri girilecek.Bunların hazırlanıp yollanması size ait.Ben aslında sadece kod yazmalıyım.Siz 5- 10 satır veri girecektiniz.:cool:
 
Evren Bey Textboxlara manuel olarak veri girilecek, Comboboxlar ile dediğim gibi rowsource ile boş olan satırlardan veri çekilecek. Rica etsem yardımcı olurmusunuz. Rowsource ile başvuruları boş olan sütunlara yaparsanız ben koda göre verileri boş satırlara girerim. Teşekkürler şimdiden.
 
alptun20' Alıntı:
Evren Bey Textboxlara manuel olarak veri girilecek, Comboboxlar ile dediğim gibi rowsource ile boş olan satırlardan veri çekilecek. Rica etsem yardımcı olurmusunuz. Rowsource ile başvuruları boş olan sütunlara yaparsanız ben koda göre verileri boş satırlara girerim. Teşekkürler şimdiden.
Genişletmek için tıkla ...
Dosyayı güncelledim.
6 numaralı mesajdan indirebilirsiniz.:cool:
 
Evren Gizlen' Alıntı:
Dosyanız ektedir.:cool:
Kod: 
Private Sub CommandButton2_Click() 'KES YAPIŞTIR
Application.ScreenUpdating = False
Sheets("AA").Select
ActiveSheet.Range("G3:GM3").Cut
ActiveSheet.Range("F3").Select
ActiveSheet.Paste
Sheets("BB").Select
ActiveSheet.Range("G4:GM4").Cut
ActiveSheet.Range("F4").Select
ActiveSheet.Paste
Sheets("CC").Select
ActiveSheet.Range("L4:GR4").Cut
ActiveSheet.Range("K4").Select
ActiveSheet.Paste
Sheets("DD").Select
ActiveSheet.Range("K4:M4").Cut
ActiveSheet.Range("J4").Select
ActiveSheet.Paste
Sheets("EE").Select
ActiveSheet.Range("F3:U3").Cut
ActiveSheet.Range("E3").Select
ActiveSheet.Paste
Sheets("ANA SAYFA").Select
Application.ScreenUpdating = True
MsgBox "işlem tamam" & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, "E V R E N"
End Sub
Genişletmek için tıkla ...

SAYIN EVREN YARDIMLARINIZ İÇİN SONSUZ TEŞEKKÜRLER.....:hey:
 
Evren Bey sanırım ben anlatma özürlüyüm. Sorunumu yeni eklediğik dosya üzerinde User Form üzerinde anlatmaya çalıştım. Yardımcı olursanız sevinirim. Yardımlarınız için teşekkürler.....
 

Ekli dosyalar

alptun20' Alıntı:
Evren Bey sanırım ben anlatma özürlüyüm. Sorunumu yeni eklediğik dosya üzerinde User Form üzerinde anlatmaya çalıştım. Yardımcı olursanız sevinirim. Yardımlarınız için teşekkürler.....
Genişletmek için tıkla ...
Yeni dosyayı nereye eklediniz.
Benim rowsource ile veri aldığım dosyayı inceledinizmi.Nersi olmamaış.:cool:
 
Evet Evren Bey yeni eklediğiniz dosyayı inceledim. Yeni eklediğim dosyada Userformun üzerine bir açıklama ekledim. Orda derdimi anlatmaya çalıştım. Alakanız için teşekkür ederim.
 
alptun20' Alıntı:
Evet Evren Bey yeni eklediğiniz dosyayı inceledim. Yeni eklediğim dosyada Userformun üzerine bir açıklama ekledim. Orda derdimi anlatmaya çalıştım. Alakanız için teşekkür ederim.
Genişletmek için tıkla ...
Dosyanız ektedir.
Userform1 için:
Kod: 
Private Sub UserForm_Initialize()
Dim i As Byte, sut As Byte, sat As Long
sut = 53
For i = 1 To 18
    sat = Sheets("Veri").Cells(65536, sut).End(xlUp).Row
    If sat > 2 Then
        Me.Controls("ComboBox" & i).RowSource = "Veri!" & _
        Range(Cells(2, sut), Cells(sat, sut)).Address
        Me.Controls("ComboBox" & i).ListIndex = 0
    End If
    sut = sut + 1
Next
End Sub
Userform2 için.:
Kod: 
Private Sub UserForm_Initialize()
Dim i As Byte, sut As Byte, sat As Long
sut = 27
For i = 1 To 7
    sat = Sheets("Şahıs").Cells(65536, sut).End(xlUp).Row
    If sat > 2 Then
        Me.Controls("ComboBox" & i).RowSource = "Şahıs!" & _
        Range(Cells(2, sut), Cells(sat, sut)).Address
        Me.Controls("ComboBox" & i).ListIndex = 0
    End If
    sut = sut + 1
Next
End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst