AW: kleine Datenbank mit Excel
02.06.2005 09:01:36
Sylvio
Ich will es mal mit Aufschlüsselung der Befehle probieren.
Sub write_to_word()
Dim text(20) As String 'Dimensionierung des Wortes Text als Stringvariable mit 20 Ablagebereichen für Werte
Dim bookmarkName(30) As String 'Analog text nur statt 20 30 Werte
Dim wrdFileName As String 'Das Wort wridFileName definiert als Stringvariable
Dim wrdDokument As Word.Document 'Das Wort wrdDokument definiert als Word-Dokument
Dim master(4) As String ' Das Wort master definiert als Stringvariable mit 4 Ablagebereichen für Werte
Dim lastactivezeile As Integer 'Das Wort lastactivezeile Als Integer definiert
Dim lastactivespalte As Integer 'analog lastactivezeile
Dim i As Integer 'analog lastactivezeile
Dim a As Integer 'analog lastactivezeile
Dim M(3) As String ' Das Wort M definiert als Stringvariable mit 3 Ablagebereichen für Werte
On Error GoTo fehlerweg 'Bei fehler gehe zu Fehlerweg. Das ist ein Sprungbefehl falls ein Fehler auftritt bringt er nicht irgendeine Fehlermeldung sondern die von mir definierte.
master(1) = ActiveWorkbook.Path & "\" 'master(1) ist die von Dir geöffnete Arbeitsmappe und davon der Pfad damit es keine Probleme gibt wenn ich Laufwerke und Ordner habe die ich nicht besitze
master(2) = ActiveWorkbook.Name 'master(2) ist die von Dir geöffnete Arbeitsmappe und davon der Name
master(3) = ActiveWorkbook.Sheets(1).Name 'master(3) ist die von Dir geöffnete Arbeitsmappe und davon der Name des ersten Datenblattes
master(4) = ActiveWorkbook.Sheets(2).Name 'master(4) ist die von Dir geöffnete Arbeitsmappe und davon der Name des ersten Datenblattes
Das mach ich falls du die Arbeitsblätter oder die Exceldatei mal umbenennst und somit kein Fehler auftritt.
wrdFileName = master(1) & "Kundenmappe.doc" 'Dies ist der Pfad deiner Excel-datei und der name des Word-Dokuments auf welches ich mich später beziehe.
lastactivezeile = ActiveCell.Row
lastactivespalte = ActiveCell.Column
Die lastactivezeile und lastactivespalte sind die Werte für Spalte und Reihe deiner zuletzt angeklickten Zelle
bookmarkName(1) = "Kundennummer"
bookmarkName(2) = "NameM1"
bookmarkName(3) = "PosM1"
bookmarkName(4) = "TelM1"
bookmarkName(5) = "MobilM1"
bookmarkName(6) = "FaxM1"
bookmarkName(7) = "emailM1"
bookmarkName(8) = "NameM2"
bookmarkName(9) = "PosM2"
bookmarkName(10) = "TelM2"
bookmarkName(11) = "MobilM2"
bookmarkName(12) = "FaxM2"
bookmarkName(13) = "emailM2"
bookmarkName(14) = "NameM3"
bookmarkName(15) = "PosM3"
bookmarkName(16) = "TelM3"
bookmarkName(17) = "MobilM3"
bookmarkName(18) = "FaxM3"
bookmarkName(19) = "emailM3"
bookmarkName(20) = "BildM1"
bookmarkName(21) = "BildM2"
bookmarkName(23) = "BildM3"
bookmarkName(1 bis 23) sind die Textmarkennamen die ich an den entsprechenden Stellen für die einzelnen Daten die später übertragen werden sollen im Word-Dokument gesetzt habe. z.B. bookmarkName(14) = "NameM3" bedeutet im Worddokument ist an der Stelle wo der Name des Mitarbeiters 3 später hinkommt die Textmarkenbezeichnung NameM3 lautet. Sie im Word unter Einfügen Textmarke.
text(1) = Workbooks(master(2)).Sheets(master(3)).Cells(lastactivezeile, 1).Value
Jetzt wird der Variable text(1) folgendes zugeordnet:
Workbooks(master(2) = Name der Exceldatei die Du geöffnet hast
Sheets(master(3)) = Name des 1 Arbeitsblattes welches sich in deiner geöffneten Exceldatei befindet
Cells(lastactivezeile,1).Value = Zelle mit der Zeile deiner zuletzt angeklickten Zelle und der Spalte 1 in deiner Mappe ist das die Spalte A
Und das ganze wird als .value der Wert der Zelle an text(1) übergeben
und bedeutet das jetzt in text(1) eine Kundennummerzahl steht die du zuletzt angeklickt hast.
M(1) = Workbooks(master(2)).Sheets(master(3)).Cells(lastactivezeile, 3).Value
M(2) = Workbooks(master(2)).Sheets(master(3)).Cells(lastactivezeile, 4).Value
M(3) = Workbooks(master(2)).Sheets(master(3)).Cells(lastactivezeile, 5).Value
M(1-3) analog text(1)
If text(1) = "" Then
MsgBox "Keine Kundennummer ausgewählt!", vbExclamation, "Auswahl", 0, 0
Exit Sub
End If
Das ist ein Fehlerhinweis falls du eine leere Zelle als letzte angeklickt hast
i = 1
Set wrdDokument = GetObject(wrdFileName)
Set ist bei mir notwendig unm mein WordDokument mit der weiterobenfestgelegten beizeichnung + Pfad zu öffnen.
Do Until Workbooks(master(2)).Sheets(master(4)).Cells(i, 1) = "" And Workbooks(master(2)).Sheets(master(4)).Cells(i + 1, 1) = ""
If Workbooks(master(2)).Sheets(master(4)).Cells(i, 1).Value = M(1) Then
text(2) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 1).Value
text(3) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 2).Value
text(4) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 3).Value
text(5) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 4).Value
text(6) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 5).Value
text(7) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 6).Value
End If
If Workbooks(master(2)).Sheets(master(4)).Cells(i, 1).Value = M(2) Then
text(8) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 1).Value
text(9) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 2).Value
text(10) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 3).Value
text(11) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 4).Value
text(12) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 5).Value
text(13) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 6).Value
a = 2
End If
If Workbooks(master(2)).Sheets(master(4)).Cells(i, 1).Value = M(3) Then
text(14) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 1).Value
text(15) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 2).Value
text(16) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 3).Value
text(17) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 4).Value
text(18) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 5).Value
text(19) = Workbooks(master(2)).Sheets(master(4)).Cells(i, 6).Value
a = 3
End If
i = i + 1
Loop
Die do until loop Schleife macht folgendes sie geht bei i=1 los sollange bis in Tabelle2 kein Mitarbeiter mehr drinsteht also ein Leerzelle da ist.
und in dieser schleife frage ich ab wenn in der gesuchten Zelle der Wert gleich dem in Tabellenblatt 1 eingetragenen Wert ist dann ordne den text die entsprechend unter .Cells(Reihe,Spalte) eingetragenen Werte zu. i ist dabei der laufparameter der immer um 1 erhöht wird pro durchlauf um immer in der entsprechenden Zeile des gerade eben gesuchten Zellwertes zu sein.
If text(2) = "" Then
MsgBox "Mitarbeiter " & M(1) & " ist nicht vorhanden", vbInformation, "Mitarbeiter", 0, 0
End If
If text(8) = "" Then
MsgBox "Mitarbeiter " & M(2) & " ist nicht vorhanden", vbInformation, "Mitarbeiter", 0, 0
End If
If text(14) = "" Then
MsgBox "Mitarbeiter " & M(3) & " ist nicht vorhanden", vbInformation, "Mitarbeiter", 0, 0
End If
Diese drei Hinweise kommen, wenn beim durchsuchen der Schleife kein entsprechender Mitarbeiter gefunden wird
'Set wrdDokument = GetObject(wrdFileName)
For i = 1 To 19
wrdDokument.Bookmarks(bookmarkName(i)).Select 'Die Textmarke im Worddokument anwählen
wrdDokument.Application.Selection.text = text(i) 'Ihr den unter text abgelegten Wert zuweisen damit wird die Textmarke überschrieben, damit das ganze aber nicht nur einmal geht nutze ich nachfolgende Befehle.
wrdDokument.Bookmarks.Add _
Range:=wrdDokument.Application.Selection.Range, _
Name:=bookmarkName(i)
Sie erstellen aus den eben übertragenen Daten eine neue Textmarke mit dem gleichen Namen wie die alte.
Next i
Jetzt lasse ich noch eine Schleife für alle 19 zu übertragenden daten durchlaufen
i wieder als laufparameter
wrdDokument.Close wdSaveChanges 'jetzt noch schön abspeichern und das Dokument schließen
Set wrdDokument = Nothing 'die Variable wrdDokument entleeren
Exit
Sub 'VBA-CODE beenden
fehlerweg: Sprungmarke falls ein Fehler im Code auftritt soll er eine Meldung bringen und beendet anschließend den VBA-Code
MsgBox "Es ist ein internes Problem aufgetreten", vbCritical, "Interner Fehler", 0, 0
End Sub
Du kannst ja mal eine Kundennummer anwählen dannach alt+f11 drücken auf module modul1 doppelklicken und den Courser vor das
Sub write_to_word() stellen anschließend f8 drücken es sollte eine gelbe markierung auftreten. Durch erneutes f8 drücken rutscht diese zum nächsten Befehl danach kannst du mit dem Courser mal über die vorhergehende Codezeile gehen langsam und über einer variable stehenbleiben, da siehst du was der Variable zugeordnet worden ist. und so kannst du Zeilenweise meinen TExt besser verstehen.
Ich hoffe das war nicht al zu verwirrend Gruß Sylvio
