referans alan ComboBox'a manuel yazmak?

[Emine Şahin]

Merhaba.
Userformum üzerinde bulunan ComboBoxlarım var.
Bunlar excel sayfasından (otomatik doldurmak için) veri alıyorlar.
Bunlara manuel olarak veri giremiyorum. Properties bölümünden ayarı var mıdır?
Baktım ama bulamadım. Ya da kodlarla alakalı mıdır?

 

[Orion1]

Merhaba.
Userformum üzerinde bulunan ComboBoxlarım var.
Bunlar excel sayfasından (otomatik doldurmak için) veri alıyorlar.
Bunlara manuel olarak veri giremiyorum. Properties bölümünden ayarı var mıdır?
Baktım ama bulamadım. Ya da kodlarla alakalı mıdır?

initialize olayındaki combobox1.style=x satırını silin.

 

[Emine Şahin]

initialize olayındaki combobox1.style=x satırını silin.

Merhaba Orion.
Kodlarım aşağıdaki gibidir. initialize olayında Öyle bir kod yok maalesef.
Birde ben burada ilk ComboBox için tarih ataması yaptım. Lakin çalıştıramadım.
Otomatik sıra numarası veren bir yervar. Onu bir türlü otomatik tarih vermesi için düzeltemedim.
Bir diğer sorunum ListBoxtan tıklayınca comboboxlara veriler geliyor.
Sil butonuna (command4) tıkladığımda hata veriyor.

Const sut = 20

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal bEnable As Long) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long, yuk As Long, gen As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
Dim buyuk As String

Private Sub Combo_Change()
TextBox1_Change
End Sub

Private Sub ComboBox1_Change()

End Sub

Private Sub CommandButton1_Click()

sat = Worksheets("veri").Cells(Rows.Count, "a").End(3).Row + 1

If ComboBox6.Text = "" Then
MsgBox "Telefon numarasını kontrol ediniz!"
Exit Sub
End If

If IsNumeric(ComboBox6.Text) <> True Then
MsgBox "Telefon numarası sayı giriniz."
Exit Sub
End If

If Len(ComboBox6.Text) < 10 Then
MsgBox "Telefon numarasını hatalı girdiniz"
Exit Sub
End If

If ComboBox2.Text = "" Then
MsgBox "Adı soyadı boş geçemezsiniz."
Exit Sub
End If


Dim TA As Range
For Each TA In Sheets("veri").Range("A2:A" & sat).Cells
If TA.Value = ComboBox2.Text Then
MsgBox ComboBox2.Text & "  " & TA.Address & "   Hücresinde bu kayıt var"
Exit Sub
End If
Next TA

a = MsgBox(sat - 1 & " " & ComboBox2.Text & " " & ComboBox3.Text & Chr(10) & Chr(10) & _
"Yeni kayıt işlemini yapmak İstiyormusunuz..?", vbYesNo + vbInformation, c & " yeni kayıt penceresi")
If a = vbNo Then
Exit Sub
End If

For i = 1 To sut
If IsNumeric(Controls("ComboBox" & i).Text) = True Then
If IsDate(Controls("ComboBox" & i).Text) = True Then
Sheets("veri").Cells(sat, i).Value = IsDate(Controls("ComboBox" & i).Text)
Else
Sheets("veri").Cells(sat, i).Value = Controls("ComboBox" & i).Text * 1
End If
Else
Sheets("veri").Cells(sat, i).Value = Controls("ComboBox" & i).Text
End If
Next i
Sheets("veri").Cells(sat, 1).Value = sat - 1
ComboBox1.Text = sat - 1
Lab = ListBox1.ListIndex + 1

TextBox1_Change

End Sub

Private Sub CommandButton5_Click()
Unload Me

End Sub

Private Sub CommandButton7_Click()

yer = "veri"
If ActiveSheet.Name <> yer Then
MsgBox "bu sayfada çalışmaz bu düğme"
Exit Sub
End If

If Combo.Text = "" Then
MsgBox "Sıralıyacağınız sutunu seçiniz ", vbInformation, c & " Hücresi"
Exit Sub
End If
a = MsgBox(Combo.Text & " Sutünunu" & Chr(10) & _
"A dan Z ye " & Chr(10) & _
"Sıralamayı Yapmak İstiyormusunuz..?", vbYesNo + vbInformation, c & " sıralama penceresi")
If a = vbNo Then
Exit Sub
End If
ad = Worksheets(yer).Cells(Rows.Count, "a").End(3).Row
ra = 2 & ":"
Rows(ra & ad).Select
TA = Combo.ListIndex + 1
YA = ra & ad
'Columns (TA)
Rows(YA).Sort Key1:=Cells(TA), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
'UserForm_Initialize
Unload Me
UserForm1.Show
End Sub

Private Sub CommandButton8_Click()
yer = "veri"
If ActiveSheet.Name <> yer Then
MsgBox "bu sayfada çalışmaz bu düğme"
Exit Sub
End If

If Combo.Text = "" Then
MsgBox "Sıralıyacağınız sutunu seçiniz ", vbInformation, c & " Hücresi"
Exit Sub
End If
a = MsgBox(Combo.Text & " Sutünunu" & Chr(10) & _
"Z den A ya " & Chr(10) & _
"Sıralamayı Yapmak İstiyormusunuz..?", vbYesNo + vbInformation, c & " sıralama penceresi")
If a = vbNo Then
Exit Sub
End If
ad = Worksheets(yer).Cells(Rows.Count, "a").End(3).Row
ra = 2 & ":"
Rows(ra & ad).Select
TA = Combo.ListIndex + 1
YA = ra & ad
'Columns(TA)
Rows(YA).Sort Key1:=Cells(TA), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Unload Me
UserForm1.Show
End Sub

Private Sub CommandButton3_Click()

If ListBox1.ListCount > 0 Then
Lab = ListBox1.ListIndex + 1
Else
MsgBox "listede hiç veri yok"
Exit Sub
End If

If Lab <= 0 Then
MsgBox "listeden veri seçiniz"
Exit Sub
End If


a = MsgBox(ComboBox1.Text & " " & ComboBox2.Text & " " & ComboBox3.Text & Chr(10) & Chr(10) & _
"Silmek İstiyor musunuz..?", vbYesNo + vbInformation, c & " silme penceresi")
If a = vbNo Then
Exit Sub
End If

sat = Val(ListBox1.List(ListBox1.ListIndex, 1))
Worksheets("veri").Rows(sat).Delete Shift:=xlUp

For i = 2 To Worksheets("veri").Cells(Rows.Count, "b").End(3).Row
Sheets("veri").Cells(i, 1).Value = i - 1
Next i
CommandButton4_Click

End Sub


Private Sub CommandButton2_Click()
If ListBox1.ListCount > 0 Then
Lab = ListBox1.ListIndex + 1
Else
MsgBox "listede hiç veri yok"
Exit Sub
End If

If Lab <= 0 Then
MsgBox "listeden veri seçiniz"
Exit Sub
End If
sat1 = Worksheets("veri").Cells(Rows.Count, "a").End(3).Row + 1

sat = Val(ListBox1.List(ListBox1.ListIndex, 1))


If ComboBox6.Text = "" Then
MsgBox "Telefon numarasını boş geçmeyiniz."
Exit Sub
End If

If IsNumeric(ComboBox6.Text) <> True Then
MsgBox "Telefon numarasını kontrol ediniz!"
Exit Sub
End If

If Len(ComboBox2.Text) < 10 Then
MsgBox "Telefon numarasını kontrol ediniz!"
Exit Sub
End If

If ComboBox3.Text = "" Then
MsgBox "Adı soyadı boş geçemezsiniz."
Exit Sub
End If


Dim TA As Range
For Each TA In Sheets("veri").Range("A2:A" & sat1).Cells
If TA.Value = ComboBox2.Text Then
MsgBox ComboBox2.Text & "  " & TA.Address & "   Hücresinde bu kayıt var"
Exit Sub
End If
Next TA

a = MsgBox(ComboBox2.Text & " " & ComboBox3.Text & Chr(10) & Chr(10) & _
"Değiştirme işlemini yapmak İstiyor musunuz..?", vbYesNo + vbInformation, " Düzeltme kayıt penceresi")
If a = vbNo Then
Exit Sub
End If


For i = 1 To sut
If IsNumeric(Controls("ComboBox" & i).Text) = True Then
If IsDate(Controls("ComboBox" & i).Text) = True Then
Sheets("veri").Cells(sat, i).Value = IsDate(Controls("ComboBox" & i).Text)
Else
Sheets("veri").Cells(sat, i).Value = Controls("ComboBox" & i).Text * 1
End If
Else
Sheets("veri").Cells(sat, i).Value = Controls("ComboBox" & i).Text
End If
Next i


MsgBox " Değişiklikler yapıldı"
End Sub

Private Sub CommandButton6_Click()
Liste = ListBox1.List 'Değişkenimize ListBox'taki listeyi aldık
ListBox1.List = Sirala(Liste, ListBox1.ColumnCount, 1)
End Sub
Private Function Sirala(Liste As Variant, Sutun_Adedi As Byte, Siralanacak_Sutun_No As Byte)
Dim i As Integer, j As Integer, say As Byte, x As Variant
For i = LBound(Liste) To UBound(Liste) - 1
For j = i + 1 To UBound(Liste)
If StrComp(Liste(i, Siralanacak_Sutun_No - 1), Liste(j, Siralanacak_Sutun_No - 1), vbTextCompare) = 1 Then
For say = 0 To Sutun_Adedi - 1
x = Liste(j, say)
Liste(j, say) = Liste(i, say)
Liste(i, say) = x
Next
End If
Next j
Next i
Sirala = Liste
End Function

Private Sub CommandButton4_Click()

For i = 1 To sut
Controls("ComboBox" & i).Text = ""
Next i

Lab = ""
TextBox1_Change

End Sub

Private Sub CommandButton9_Click()
On Error Resume Next
'sut = Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).End(xlToLeft).Column + 1
satır = Worksheets("veri").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sutun = Worksheets("veri").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Worksheets("veri").Range(Worksheets("veri").Cells(2, 1), Cells(satır, sutun)).Select
Application.Dialogs(39).Show
Range("a1").Select
End Sub


Private Sub ListBox1_Click()
sat = Val(ListBox1.List(ListBox1.ListIndex, 1))
For i = 1 To sut
Controls("ComboBox" & i) = Sheets("veri").Cells(sat, i).Value
Next i
Lab = ListBox1.ListIndex + 1

End Sub


Private Sub UserForm_Resize()
If buyuk = "" Then
X1 = Application.Width
Y1 = Application.Height
X2 = yuk
Y2 = gen
CX = X1 / X2
CY = Y1 / Y2
Dim MyCtrl As Control

For Each MyCtrl In Me.Controls

MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
'On Error Resume Next
MyCtrl.Font.Size = 18 'MyCtrl.Font.Size * CY

On Error GoTo 0
Next
buyuk = "ok"
Else
X1 = Application.Width
Y1 = Application.Height
X2 = yuk
Y2 = gen
CX = X1 / X2
CY = Y1 / Y2
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top / CY
MyCtrl.Left = MyCtrl.Left / CX
MyCtrl.Width = MyCtrl.Width / CX
MyCtrl.Height = MyCtrl.Height / CY
'On Error Resume Next

MyCtrl.Font.Size = 8

On Error GoTo 0
Next
buyuk = ""
End If
End Sub
Private Sub UserForm_Initialize()
yuk = Me.Width
gen = Me.Height
buyuk = ""
'Combo.RowSource = "Sayfa1!E3:E" & Sheets("sayfa1").[E65536].End(3).Row

    ComboBox9.Style = 2
    ComboBox10.Style = 2
    ComboBox11.Style = 2
    ComboBox12.Style = 2
    ComboBox13.Style = 2
    ComboBox14.Style = 2
    ComboBox15.Style = 2
    ComboBox16.Style = 2
    ComboBox17.Style = 2
    
    Dim sat As Long
    sat = Sheets("parametreler").Cells(Rows.Count, "A").End(xlUp).Row
    ComboBox9.ShowDropButtonWhen = 0
    ComboBox9.RowSource = "parametreler!A2:A" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "B").End(xlUp).Row
    ComboBox10.ShowDropButtonWhen = 0
    ComboBox10.RowSource = "parametreler!B2:B" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "C").End(xlUp).Row
    ComboBox12.ShowDropButtonWhen = 0
    ComboBox12.RowSource = "parametreler!C2:C" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "D").End(xlUp).Row
    ComboBox13.ShowDropButtonWhen = 0
    ComboBox13.RowSource = "parametreler!D2:D" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "C").End(xlUp).Row
    ComboBox14.ShowDropButtonWhen = 0
    ComboBox14.RowSource = "parametreler!E2:E" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "F").End(xlUp).Row
    ComboBox15.ShowDropButtonWhen = 0
    ComboBox15.RowSource = "parametreler!F2:F" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "G").End(xlUp).Row
    ComboBox16.ShowDropButtonWhen = 0
    ComboBox16.RowSource = "parametreler!G2:G" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "H").End(xlUp).Row
    ComboBox17.ShowDropButtonWhen = 0
    ComboBox17.RowSource = "parametreler!H2:H" & sat
    
    sat = Sheets("parametreler").Cells(Rows.Count, "I").End(xlUp).Row
    ComboBox18.ShowDropButtonWhen = 0
    ComboBox18.RowSource = "parametreler!I2:I" & sat
    
    ComboBox1.Value = Format(Date, "dd.mm.yyyy")


For i = 1 To sut
Controls("Label" & i) = Sheets("veri").Cells(1, i).Value
Combo.AddItem Sheets("veri").Cells(1, i).Value
Next i

Combo.Text = Combo.List(2)

Combo_Change

'MsgBox kod1 & Chr(10) & kod2 & Chr(10) & kod3 & Chr(10) & kod4 & Chr(10) & kod5 & Chr(10) & kod6 & Chr(10) & kod7 & Chr(10) & kod8

Dim hWnd As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H35000

End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then
MsgBox ("Çıkış Düğmesini Kullanınız")
Cancel = 1
End If
End Sub


Private Sub TextBox1_Change()
If OptionButton1.Value = True Then
sirala1_Click
Else
sirala2_Click
End If
End Sub


Private Sub sirala1_Click()

If Combo.ListIndex > 0 Then
sat = Combo.ListIndex + 1
Else
sat = 2
End If

Dim i As Integer
Dim j As Integer
Dim aranan1 As String
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "100;0;0" 'lisbox'taki sütunların genişliği
sat1 = 0
j = Len(TextBox1.Text)
For i = 2 To Worksheets("veri").[a65536].End(3).Row
'aranan1 = LCase(Mid(Sheets("veri").Cells(i, sat).Value, 1, j))
aranan1 = UCase(Replace(Replace(LCase(Mid(Sheets("veri").Cells(i, sat).Value, 1, j)), "ı", "I"), "i", "İ"))
If Worksheets("veri").Cells(i, sat).Value > 0 Then
If TextBox1.Text <> "" Then
'If aranan1 = LCase(TextBox1.Text) Then
If aranan1 = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")) Then

ListBox1.AddItem
ListBox1.List(sat1, 0) = Sheets("veri").Cells(i, sat).Value
ListBox1.List(sat1, 1) = i
sat1 = sat1 + 1
End If
Else
ListBox1.AddItem
ListBox1.List(sat1, 0) = Sheets("veri").Cells(i, sat).Value
ListBox1.List(sat1, 1) = i
sat1 = sat1 + 1
End If
End If
Next

End Sub

Private Sub sirala2_Click()

If Combo.ListIndex > 0 Then
sat = Combo.ListIndex + 1
Else
sat = 2
End If
Dim i As Integer
Dim j As Integer
Dim aranan1 As String
ListBox1.Clear

ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "100;0;0" 'lisbox'taki sütunların genişliği
sat1 = 0
j = Len(TextBox1.Text)
For i = 2 To Worksheets("veri").[a65536].End(3).Row
'aranan1 = LCase(TextBox1.Text)
aranan1 = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ"))

If Worksheets("veri").Cells(i, sat).Value > 0 Then
If TextBox1.Text <> "" Then
deg = 0
For j = 1 To Len(Sheets("veri").Cells(i, sat).Value)
'If aranan1 = LCase(Mid(Sheets("veri").Cells(i, sat).Value, j, Len(TextBox1.Text))) Then
If aranan1 = UCase(Replace(Replace(Mid(Sheets("veri").Cells(i, sat).Value, j, Len(TextBox1.Text)), "ı", "I"), "i", "İ")) Then
deg = 1
End If
Next
If deg = 1 Then
ListBox1.AddItem
ListBox1.List(sat1, 0) = Sheets("veri").Cells(i, sat).Value
ListBox1.List(sat1, 1) = i
sat1 = sat1 + 1
End If
Else
ListBox1.AddItem
ListBox1.List(sat1, 0) = Sheets("veri").Cells(i, sat).Value
ListBox1.List(sat1, 1) = i
sat1 = sat1 + 1
End If
End If
Next

End Sub