Bestücken Excel-Daten in Word-Dokument mit VBA

Question

Ich habe ein Word-Dokument und ich möchte die gleichen Wörter aus Excel kommen. Sagen wir mal, beide sind in c: \ test Ich habe ein wenig Erfahrung mit VBA, aber dieses ist ein wenig drüber. In meinem Word-Dokument Ich habe einen Satz sagen läßt: Ich bin firstnamelastname und my username is username und dies ist meine Abteilung: department

Ich habe eine Excel-Daten genannt, mit einem Blatt namens sheet1 mit einem Tisch Benutzer aufgerufen und einige Spalten: Benutzername, Vorname, Nachname, Abteilung. Die Tabelle ist eine verknüpfte odbc-Tabelle und wird aktualisiert, wenn die Arbeitsmappe geöffnet wird.

1. Meine erste Frage ist, welche Art von Objekt sollte ich für Vorname, Nachname, Benutzername, deparment in Wort verwenden? Ich legte einen Rich-Text-Steuerelement Inhalt und in diesem ein Legacy-Formular/Textfeld Feld und benannte die Lesezeichen in Vorname, Nachname .. usw.
2. Ich möchte die Daten in Word von Excel mit Makro und Vlookup bevölkern. Ich habe keine Ahnung, wie das gemacht werden kann, ich habe ein bisschen Code, aber es funktioniert nicht. Wenn das Makro gestartet sollte ein Fenster mit dem username und die anderen Felder auf diesem Wert basiert haben, erscheint ausgefüllt werden

-Code. Unten:

Dim objExcel As Object 
Set objExcel = CreateObject("Excel.Application") 
Dim username As String 
Dim firstname As String 
Dim lastname As String 
Dim department As String 

username = InputBox("Please enter the username", "Input") 

Set exWb = objExcel.Workbooks.Open("C:\test\data.xlsx") 

username = objExcel.WorksheetFunction.VLookup(username, _ 
eexWb.ActiveSheet.Range("A:F"), 1, False) 

firstname = objExcel.WorksheetFunction.VLookup(username, _ 
eexWb.ActiveSheet.Range("A:F"), 2, False) 

lastname = objExcel.WorksheetFunction.VLookup(username, _ 
eexWb.ActiveSheet.Range("A:F"), 3, False) 

department = objExcel.WorksheetFunction.VLookup(username, _ 
eexWb.ActiveSheet.Range("A:F"), 4, False) 

exWb.Close 

Set exWb = Nothing 

Answer 1

Das sollte unter Code erreichen, was Sie brauchen. Nehmen Sie die folgenden Hinweise:

1. Ich verwendete frühe Bindung (um intellisense zu nutzen). Überprüfen Sie in dem Word VBE in Extras> Verweise Microsoft Excel XX.X-Objektbibliothek
2. Sie können ein einfaches Lesezeichen erstellen, ohne Objekte einfügen zu müssen. Möglicherweise möchten Sie das noch tun, aber Sie müssen möglicherweise die UpdateBookmark Prozedur anpassen, damit es richtig funktioniert.

Code:

Sub LoadInfo() 

    Dim objExcel As Excel.Application 'note early binding (set in Tools > References > Microsoft Excel XX.X library 
    Set objExcel = New Excel.Application 

    Dim username As String 
    Dim firstname As String 
    Dim lastname As String 
    Dim department As String 

    username = InputBox("Please enter the username", "Input") 

    Dim exWB as Excel.Workbook   
    Set exWB = objExcel.Workbooks.Open("C:\test\data.xlsx") 

    With exWB.Worksheets("Sheet1") 

     Dim rngUN As Excel.Range 
     Set rngUN = .Columns("A").Find(what:=username, lookat:=xlWhole) 

     If Not rngUN Is Nothing Then 

      firstname = rngUN.Offset(, 2) 
      lastname = rngUN.Offset(, 3) 
      department = rngUN.Offset(, 4) 

     Else 

      MsgBox "Username Not Found. Exiting Sub" 
      GoTo ExitSub 

     End If 

    End With 

    UpdateBookmark "username", username, ActiveDocument, False 
    UpdateBookmark "firstname", firstname, ActiveDocument, False 
    UpdateBookmark "lastname", lastname, ActiveDocument, False 
    UpdateBookmark "department", department, ActiveDocument, False 

ExitSub: 
     exWB.Close 
     objExcel.Quit 


    End Sub 

Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String, wDoc As Word.Document, Optional bReplace As Boolean) 
'updates a bookmark range in Word without removing the bookmark name 

    Dim BMRange As Word.Range 
    Dim sTest As String 

    With wDoc 

     Set BMRange = .Bookmarks(BookmarkToUpdate).Range 

     'if text already exists, add new to old with a carriange return in between 
     sTest = BMRange.Text 

     If sTest = "" Or bReplace Then 

      BMRange.Text = TextToUse 

     Else 

      BMRange.Text = sTest & vbCr & TextToUse 

     End If 

     .Bookmarks.Add BookmarkToUpdate, BMRange 

    End With 

End Sub