AW: Ergänzung
01.10.2005 22:10:54
Walter
Hallo Matthias,
anbei das kompl. Makro:
Private Sub ComboBox5_Change() '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 strValue As String
Dim Fname
Dim walter
Dim UserForm
Dim ww
Call CommandButton4_Click
Set wsDatabase = Sheets("Datenbank") ' Datenblatt zuweisen
Sheets("Datenbank").Unprotect ("wwpa")
strValue = ComboBox5.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
ElseIf wsDatabase.Cells(intY, 11).Value = strValue Then
Exit For ' ebenso wenn Name gefunden
End If
Next
Dim dat As Date
ComboBox3.Value = wsDatabase.Cells(intY, 1).Value 'Fahrz. Typ rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("U1") = ComboBox3.Value
TextBox1.Value = wsDatabase.Cells(intY, 2).Value 'kopiert Verkäufer Nr rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("Y10") = TextBox1.Value
TextBox30.Value = wsDatabase.Cells(intY, 3).Value 'kopiert Verkäufer Provision rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("U63") = (TextBox30)
ComboBox4.Value = wsDatabase.Cells(intY, 4).Value ' VK Symbol
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("C77") = ComboBox4.Value
If dat >= DateValue("01.07.2005") Then
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("BG318") = ComboBox4.Value
End If
If dat < DateValue("01.07.2005") Then
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AV318") = ComboBox4.Value
End If
TextBox39.Value = wsDatabase.Cells(intY, 5).Value 'kopiert Datum rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("F11") = TextBox39.Value
ComboBox6.Value = wsDatabase.Cells(intY, 6).Value 'Fahrz. Typ rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("T10") = ComboBox6.Value
TextBox18.Value = wsDatabase.Cells(intY, 7).Value 'kopiertProduktionscode rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("V14") = TextBox18.Value
If wsDatabase.Cells(intY, 8) = "NW" Then CheckBox2.Value = True
If wsDatabase.Cells(intY, 8) = "VF" Then CheckBox5.Value = True
If wsDatabase.Cells(intY, 8) = "TZ" Then CheckBox9.Value = True
TextBox7.Value = wsDatabase.Cells(intY, 9).Value 'kopiert Anrede rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AU337") = TextBox7.Value
TextBox8.Value = wsDatabase.Cells(intY, 10).Value 'kopiert Vorname rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AU338") = TextBox8.Value
TextBox22.Value = wsDatabase.Cells(intY, 11).Value 'kopiert Kundenname rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AY338") = TextBox22.Value
TextBox9.Value = wsDatabase.Cells(intY, 12).Value 'kopiert Ansprechpartner rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AU339") = TextBox9.Value
TextBox10.Value = wsDatabase.Cells(intY, 13).Value 'kopiert Strasse rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AU341") = TextBox10.Value
TextBox11.Value = wsDatabase.Cells(intY, 14).Value 'kopiert Haus Nr. rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AY341") = TextBox11.Value
TextBox12.Value = wsDatabase.Cells(intY, 15).Value 'kopiert PLZ rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AU342") = TextBox12.Value
TextBox13.Value = wsDatabase.Cells(intY, 16).Value 'kopiert Ort rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("AY342") = TextBox13.Value
TextBox14.Value = wsDatabase.Cells(intY, 17).Value 'kopiert MBVS Nr. rein
ThisWorkbook.Worksheets("Kulanzblatt-VK").Range("T11") = TextBox14.Value
'--------------------- ab sortieren --------------------------------------------
Dim L
Dim z
Application.ScreenUpdating = False
z = ActiveCell().Row
L = Range("a1").End(xlDown).Row
Sheets("Datenbank").Select
Range("a1").Select
If Not ActiveSheet.ProtectContents Then 'wird abgefragt, wenn schutz
ActiveSheet.Unprotect ("wwpa") 'aufgehoben ist dann ende sonst
Else
ActiveSheet.Unprotect ("wwpa")
End If
Sheets("Datenbank").Select
Range("a1").Select
'----- hier sortieren nach Nachnamen ----------------------------------------
Selection.Sort Key1:=Range("K2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Range(Cells(z, 1), Cells(z, 1)).Select 'geht zur aktiven zelle
Sheets("Datenbank").Select
Application.ScreenUpdating = True
End Sub
Gruß Walter