leider nicht so richtig verstanden...
23.06.2004 16:24:26
Walter
Hallo Manuele,
ehrlich gesagt, nicht so richtig verstanden. Ich schicke noch einmal das Makro:
Public
Sub N_NW_DropName_BeiÄnderung() 'Adressdaten aus Datenbank lesen
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 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
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.xls").Activate ' ich gesetzt, hier muß rein sonst bricht ab
ElseIf wsDatabase.Cells(intY, 9).Value = NWDlg.DropDowns("DropName").List(intA) Then
Exit For ' ebenso wenn Name gefunden
End If
Next
VKNR.Text = wsDatabase.Cells(intY, 1).Value 'kopiert Verkäufer Nr rein
Kuanr.Text = wsDatabase.Cells(intY, 2).Value 'kopiert Anrede rein
KuN.Text = wsDatabase.Cells(intY, 3).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.xls").Activate ' ich gesetzt, hier muß rein sonst bricht ab
Application.ScreenUpdating = True
End Sub
Jetzt sollte bei anklicken des DropDowns Button NEU eingelesen werden.
Wenn ich eine ALTE Adresse lösche, steht allerdings immer noch der Name drin.
Gruß Walter