Bitte um Unterstützung !!! Wichtig
03.09.2004 15:21:19
walter
habe gestern abend gegen 21.00Uhr ein Mail bzüglich ComboBox geschrieben.
Hier noch einmal mein anliegen:
Ich habe mit Unterstützung des Forums ein Makro zusammengestrickt, welches die
Daten aus einer Datenbank (Spalte 9)durch ein DropDown "reingezogen"werden, nun möchte ich diese Makro auf Basis einer ComboBox ändern (UserForm).
Ich probiere nun schon seit gestern Nacht und kriege es nicht hin.
Deshalb bitte ich um Verständnis wenn ich mich noch einmal melde, weil ich dies dringend benötige !!!
Hier mein Makro:
Public Sub N_NW_DropName_BeiÄnderung() 'Adressdaten aus Datenbank lesen
'ehem.Kopfleiste
Private Sub ComboBox5_Change()
Application.ScreenUpdating = False
Dim wbDatei, wb As Workbook
Dim wsDatabase As Worksheet
Dim Datei As String
Dim bolOpen As Boolean
Dim aVarData() As String
Dim intY, intA As Integer
Dim Fname 'ich Neu eingesetzt
'Dim NWDlg As Object
'Dim VKNR As Object
'Dim Kuanr As Object
'Dim KuN As Object
'Dim Kustr As Object
'Dim StrNr As Object
'Dim PLZ As Object
'Dim KuOrt As Object
'Dim MBVSNR As Object
Datei = "1-NW-PLK-Datenbank.xls" ' Name der Datenbank
Fname = "C:\1_PKW_Verkauf\" & Datei ' kompletter Pfad der Datenbank
bolOpen = False
For Each wb In Application.Workbooks
If wb.Name = Datei Then ' Datenbank schon geöffnet?
bolOpen = True
Exit For
End If
Next
If bolOpen = False Then Workbooks.Open Filename:=Fname
'wenn nicht, dann öffnen
Set wbDatei = Application.Workbooks(Datei) ' Datenbank zuweisen
Set wsDatabase = wbDatei.Worksheets("Datenbank") ' Datenblatt zuweisen
'Set NWDlg = ThisWorkbook.Sheets("NWDlg")
'Set VKNR = NWDlg.EditBoxes("VKNR")
'Set Kuanr = NWDlg.EditBoxes("Anrede")
'Set KuN = NWDlg.EditBoxes("KundenN")
'Set Kustr = NWDlg.EditBoxes("Kundenstr")
'Set StrNr = NWDlg.EditBoxes("StrNr")
'Set PLZ = NWDlg.EditBoxes("PLZ")
'Set KuOrt = NWDlg.EditBoxes("KundenOrt")
'Set MBVSNR = NWDlg.EditBoxes("MBVSNR")
'intA = NWDlg.DropDowns("DropName").Value
' ausgewählte Zeile in Dropdown Excel 97
intA = ComboBox5.Value ' ich NEU eingesetzt
For intY = 2 To 1000 ' Eintrag in Datenbank suchen 1000 Zeilen nach unten
If wsDatabase.Cells(intY, 1) = "" Then ' wenn leere Zelle gefunden
Exit For ' raus aus Schleife
Windows("1-nw-plk-VB.xls").Activate
'ElseIf wsDatabase.Cells(intY, 9).Value = NWDlg.DropDowns("DropName").List(intA) Then
ElseIf wsDatabase.Cells(intY, 9).Value = ComboBox5.List(intA) Then
Exit For ' ich Neu eingesetzt
End If
Next
'VKNR.Text = wsDatabase.Cells(intY, 1).Value 'kopiert Verkäufer Nr rein
TextBox1 = wsDatabase.Cells(intY, 1).Value 'kopiert Verkäufer Nr rein
'Kuanr.Text = wsDatabase.Cells(intY, 2).Value 'kopiert Anrede rein
TextBox7 = wsDatabase.Cells(intY, 2).Value 'kopiert Anrede rein
'KuN.Text = wsDatabase.Cells(intY, 3).Value 'kopiert Kundenname rein
TextBox9 = wsDatabase.Cells(intY, 2).Value 'kopiert Kundenname rein
'Kustr.Text = wsDatabase.Cells(intY, 4).Value 'kopiert Strasse rein
'StrNr.Text = wsDatabase.Cells(intY, 5).Value 'kopiert Haus Nr rein
'PLZ.Text = wsDatabase.Cells(intY, 6).Value 'kopiert PLZ rein
'KuOrt.Text = wsDatabase.Cells(intY, 7).Value 'kopiert Ort rein
'MBVSNR.Text = wsDatabase.Cells(intY, 8).Value
Application.DisplayAlerts = False 'von mir Sicherheitsabfrage unterdrücken
Windows("1-nw-plk-VB.xls").Activate ' ich gesetzt, hier muß rein sonst bricht
Application.ScreenUpdating = True
End Sub
Bitte helft mir, danke im voraus
Gruss Walter