• DİKKAT

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

Makro Gruplari

Katılım
30 Nisan 2009
Mesajlar
16
Excel Vers. ve Dili
VBA 2003
Ekteki dosyada her bir file grubun yanindaki file type'lar var. Istedigim entry butonuna basilinca once file grup secilsin ve file type da ise sadece bu grubun yanindaki file type'lar goruntulensin, digerleri goruntulenmesin. Yardimlarinizi rica ederim. Tesekkurler,
 

Ekli dosyalar

Ben de hazırlamıştım, mantık aynı ufak tefek farklılıklar var, alternatif olsun.
Kod:
Private Sub ComboBox2_Change()
ComboBox3.Clear
son = [L65536].End(xlUp).Row
For i = 2 To son
If Cells(i, "K") = ComboBox2.Value Then ComboBox3.AddItem Cells(i, "L")
Next
End Sub
Kod:
Private Sub UserForm_Initialize()
Dim cb2 As New Collection
UserForm1.Caption = Sheets("archiveformatdescription").Range("H1").Value
ComboBox1.RowSource = "archiveformatdescription!I1:I1000"
For i = 1 To 7
Controls("label" & i) = Cells(1, i)
Next
son = [K65536].End(xlUp).Row
On Error Resume Next
For i = 2 To son
cb2.Add Cells(i, "K"), CStr(Cells(i, "K"))
Next
On Error GoTo 0
For Each Item In cb2
ComboBox2.AddItem Item
Next
End Sub
 
Arkadaşlar ekteki dosyada, butona bastığımda bütün alanları doldurduğum halde, doldurmamışım gibi işlem yapmama devam ettirmiyor beni. Önce Entry butonuna tıklıyorum, daha sonra bütün alanları doldurup, Proceed tuşuna tıklıyorum. Ancak sanki bütün alanları doldurmamışım gibi oluyor. Konu ile ilgili yardımlarınızı rica ederim.

Teşekkürler.
 

Ekli dosyalar

If TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "" And TextBox4 <> "" And TextBox5 <> "" And TextBox6 <> "" And ComboBox1 <> "" And TextBox7 <> "" And TextBox8 <> "" Then

TextBox4 ve TextBox5 userformda yok da ondan kırmızı yerleri silin belki uyarı vermez.
 
Malesef halen aynı uyarı mesajını veriyor. Başka ne yapabilirim bu konu ile ilgili?

Teşekkürler,
 
kodların içindede fazlalıklar var kodları bunula değiştirin:

Private Sub CommandButton1_Click()
If TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "" And TextBox6 <> "" And TextBox7 <> "" And TextBox8 <> "" Then
FEDEAL1 = Sheets("archiveformatdescription").Range("A65536").End(xlUp).Row + 1
Sheets("archiveformatdescription").Range("A" & FEDEAL1).Value = TextBox1.Text
Sheets("archiveformatdescription").Range("B" & FEDEAL1).Value = TextBox2.Text
Sheets("archiveformatdescription").Range("C" & FEDEAL1).Value = TextBox3.Text
Sheets("archiveformatdescription").Range("F" & FEDEAL1).Value = ComboBox2.Text
Sheets("archiveformatdescription").Range("H" & FEDEAL1).Value = TextBox6.Text
Sheets("archiveformatdescription").Range("I" & FEDEAL1).Value = TextBox7.Text
Else
MsgBox "Please fill out all fields", , Sheets("archiveformatdescription").Range("I1").Value
End If
End Sub
 
Kusura bakmayın sizi çok uğraştırdım. Ancak bu sefer de ekteki hata mesajını aldım. Bana yardımcı olabilir misiniz lütfen? Teşekkürler.
 

Ekli dosyalar

FEDEAL1 = Sheets("archiveformatdescription").Range("A65536").End(xlUp).Row + 1
kodun arasında boşluk var silin düzelir.(Range("A65536") bu bölgede .End(xlUp).Row + 1)
 
Çok teşekkür ederim. Kod şu anda aşağıdaki gibi. Ancak giriş yaptığımda ekteki hata mesajını alıyorum. Bu neden kaynaklanıyor olabilir? Teşekkürler.

Private Sub CommandButton1_Click()
If TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "" And TextBox4 <> "" And ComboBox1 <> "" And ComboBox2 <> "" And TextBox5 <> "" And TextBox6 <> "" And TextBox7 <> "" Then
FEDEAL1 = Sheets("archiveformatdescription").Range("A65536").End(xlUp).Row + 1
Sheets("archiveformatdescription").Range("A" & FEDEAL1).Value = TextBox1.Text
Sheets("archiveformatdescription").Range("B" & FEDEAL1).Value = TextBox2.Text
Sheets("archiveformatdescription").Range("C" & FEDEAL1).Value = TextBox3.Text
Sheets("archiveformatdescription").Range("D" & FEDEAL1).Value = TextBox4.Text
Sheets("archiveformatdescription").Range("E" & FEDEAL1).Value = ComboBox1.Text
Sheets("archiveformatdescription").Range("F" & FEDEAL1).Value = ComboBox2.Text
Sheets("archiveformatdescription").Range("G" & FEDEAL1).Value = TextBox5.Text
Sheets("archiveformatdescription").Range("H" & FEDEAL1).Value = TextBox6.Text
Sheets("archiveformatdescription").Range("I" & FEDEAL1).Value = TextBox7.Text
Else
MsgBox "Please fill out all fields", , Sheets("archiveformatdescription").Range("I1").Value
End If
End Sub
 

Ekli dosyalar

Ben var diye görüyorum. Bütün dosyayı size gönderiyorum. Ben mi bir yerde hata yapıyorum? Yardımlarınızı rica ederim. Teşekkürler.
 

Ekli dosyalar

textbox4 gönderdiginizdede yok hatta combobox1 de göremedim ama var görünüyor
 
If TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "" And TextBox4 <> "" And ComboBox1 <> "" And ComboBox2 <> "" And TextBox5 <> "" And TextBox6 <> "" And TextBox7 <> "" Then

koddaki bu satır textboxlar boş ise bizi uyarmayı saglıyor sizin hata dediginiz hadise bizim oluşturdugumuz msgbox textbox4 yok ayrıca combobx1i göremedim bunlara bilgi girmeyince uyarı alcagız.kontrol edin.
 
Çok teşekkür ederim. Elleriniz sağlık.
 
Geri
Üst