Soru Hata Kodu

C

cemalizm

Katılım
29 Mart 2013
Mesajlar
13
Excel Vers. ve Dili
2007 Türkçe
Herkese merhaba,

Bir kaç tane UserForm da kullandığım bir çalışma dosyam mevcut. Bazen aşağıdaki hata mesajı çıkıyor ve UserFormlar açılmıyor. (UserForm1 ve UserForm2) Dosyayı kapatıp yeniden açtıktan sonra hata vermeden çalışıyor. Ancak bir süre geçtikten sonra yine aynı hata mesajı ile karşılaşıyorum. Siteden bulmuş olduğum kodları uyarlarken sanırım bir yerlerde hata yaptım.

Hata Mesajı:
Run-time error '-2147352571 (800200005)':
Could not set the ColumnWidths property. Tür Uyuşmazlığı

Userform1 ve Userform2 için kullandığım kodlar hemen aynı. Acaba konu ile ilgili bir çözüm öneriniz olabilir mi?

Destekleriniz için şimdiden çok teşekkürler.

Userform1 için kullandığım kodlar: (UserForm_Initialize için kullanılan sayfa (HCP) 110.000 satır veri içermektedir)
Kod: 
Sub combo()
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    con.Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=no;imex=1"""
    sorgu = "Select distinct [F5] from [HCPFilter$]"
    rs.Open sorgu, con, 1, 1
    If rs.RecordCount > 0 Then
        ComboBox2.Column = rs.GetRows
    End If
End Sub

Private Sub ComboBox2_Change()

Dim con As Object, rs As Object
ListBox1.RowSource = Empty

On Error Resume Next
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;" & "data source=" & ThisWorkbook.FullName & ";" & _
"extended properties=""excel 12.0;hdr=no"""
  sorgu = "select * from [HCPFilter$] where F5 like '%" & ComboBox2.Text & "%'"
rs.Open sorgu, con, 1, 1

With ListBox1
    .ColumnCount = rs.Fields.Count
    .Column = rs.GetRows
End With
ListBox1.AddItem Sheets("HCPFilter").Range("a1"), 0
For baslik = 1 To 5
ListBox1.List(0, baslik - 1) = Sheets("HCPFilter").Cells(1, baslik)
Next baslik


End Sub

Private Sub CommandButton1_Click()
'basla = Timer
    'If Len(TextBox1.Text) > 3 Then
    Dim con As Object
    Dim rs  As Object
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
 
    Sayfa2.Range("A2:E100000").Value = ""
 
    sorgu = "select * from [HCP$] Where [F1] like '%" & TextBox1.Text & "%' And [F2] Like '%" & ComboBox1.Text & "%'"
    Set rs = con.Execute(sorgu)
 
 
 
    Sayfa2.Range("a" & Rows.Count).End(3).Offset(1, 0).Cells.CopyFromRecordset rs
 
    With ListBox1
        .RowSource = ""
        .ColumnCount = 5
        .ColumnWidths = "150,75,200,150,150"
        son = Sayfa2.Cells(Rows.Count, 1).End(xlUp).Row
        ListBox1.RowSource = "HCPFilter!A1:E" & son
    End With
 
 
 
    Set rs = Nothing
    Set con = Nothing
 
    Label4 = ListBox1.ListCount - 1
    'End If
 
    combo
 
'bitis = Timer
'sure = bitis - basla
'MsgBox sure & " Saniye"
End Sub



Private Sub UserForm_Initialize()
Dim ws As Worksheet
 
    Set ws = Sheets("HCP")
    With Me.ListBox1
        .List = ws.Range("a2", ws.Range("a" & Rows.Count).End(xlUp)) _
        .Resize(, 5).Value
        .ColumnCount = 5
        .ColumnWidths = "150,75,200,150,150"
    End With
    Set ws = Nothing
 
Label2 = ListBox1.ListCount
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
            ActiveCell.Value = Me.ListBox1.List(i, 0)
            ActiveCell.Offset(0, 1).Value = Me.ListBox1.List(i, 1)
            ActiveCell.Offset(0, 2).Value = Me.ListBox1.List(i, 2)
    End If
Next i


End Sub

Userform 2 için kullandığım kodlar: (UserForm_Initialize için kullanılan sayfa (CRO) 9.000 - 10.000 satır veri içermektedir)
Kod: 
Sub combo()
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    con.Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=no;imex=1"""
    sorgu = "Select distinct [F4] from [CROFilter$]"
    rs.Open sorgu, con, 1, 1
    If rs.RecordCount > 0 Then
        ComboBox2.Column = rs.GetRows
    End If
End Sub

Private Sub CommandButton2_Click()

For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
            UserForm3.Label14 = Me.ListBox1.List(i, 1)
            UserForm3.Label16 = Me.ListBox1.List(i, 2)
            UserForm5.Label14 = Me.ListBox1.List(i, 1)
            UserForm5.Label16 = Me.ListBox1.List(i, 2)
    End If
Next i

Unload Me

Sheet4.Range("A2:H10000").Clear

End Sub

Private Sub UserForm_Initialize()
Dim ws As Worksheet
 
    Set ws = Sheets("CRO")
    With Me.ListBox1
        .List = ws.Range("a2", ws.Range("a" & Rows.Count).End(xlUp)) _
        .Resize(, 5).Value
        .ColumnCount = 5
        .ColumnWidths = "75,75,300,100,100"
    End With
    Set ws = Nothing
 
Label2 = ListBox1.ListCount
End Sub


Private Sub ComboBox1_Change()

'basla = Timer
    'If Len(TextBox1.Text) > 3 Then
    Dim con As Object
    Dim rs  As Object
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
 
    Sheet4.Range("A2:H10000").Value = ""
 
    Set rs = con.Execute("select * from [CRO$] Where [F1] like '%" & ComboBox1.Text & "%'")
 
 
 
    Sheet4.Range("a" & Rows.Count).End(3).Offset(1, 0).Cells.CopyFromRecordset rs
 
    With ListBox1
        .RowSource = ""
        .ColumnCount = 5
        .ColumnWidths = "75,75,300,100,100"
        son = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
        ListBox1.RowSource = "CROFilter!A1:E" & son
    End With
 
 
 
    Set rs = Nothing
    Set con = Nothing
 
    Label4 = ListBox1.ListCount - 1
    Label5 = ComboBox1.Text
    combo
 
    'End If
 
 
'bitis = Timer
'sure = bitis - basla
'MsgBox sure & " Saniye"

End Sub


Private Sub CommandButton1_Click()

Dim con As Object, rs As Object
ListBox1.RowSource = Empty

On Error Resume Next
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;" & "data source=" & ThisWorkbook.FullName & ";" & _
"extended properties=""excel 12.0;hdr=no"""

  sorgu = "select * from [CROFilter$] Where f3 like '%" & TextBox1.Text & "%' And [F4] Like '%" & ComboBox2.Text & "%'"
 
    Set rs = con.Execute(sorgu)

rs.Open sorgu, con, 1, 1



With ListBox1
    .ColumnCount = 5
    .ColumnWidths = "75,75,300,100,100"
    .Column = rs.GetRows
End With
ListBox1.AddItem Sheets("CROFilter").Range("a1"), 0
For baslik = 1 To 5
ListBox1.List(0, baslik - 1) = Sheets("CROFilter").Cells(1, baslik)
Next baslik

If TextBox1.Value <> "" Then
Label7.Visible = True
Label8.Visible = True
Label7 = TextBox1.Text
Label8 = ListBox1.ListCount - 1
End If

End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
            ActiveCell.Value = Me.ListBox1.List(i, 1)
            ActiveCell.Offset(0, 1).Value = Me.ListBox1.List(i, 2)
    End If
Next i

Unload Me

Sheet4.Range("A2:H10000").Clear

End Sub
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki satıra benzeyen bütün satırlardaki virgülleri noktalı virgül ile değiştirmeyi deneyiniz.

.ColumnWidths = "150,75,200,150,150"
 
C

cemalizm

Katılım
29 Mart 2013
Mesajlar
13
Excel Vers. ve Dili
2007 Türkçe
Korhan Ayhan' Alıntı:
Aşağıdaki satıra benzeyen bütün satırlardaki virgülleri noktalı virgül ile değiştirmeyi deneyiniz.

.ColumnWidths = "150,75,200,150,150"
Genişletmek için tıkla ...
Korhan Bey merhaba,

Söylediğiniz değişikliği uyguladım, şu an için problem çözülmüş görünüyor.

İlginiz için çok teşekkürler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst