Werte von Excel in Word
Excel
es ist zwar ein Word/Excel-Problem aber ich denke ihr könnt mir bestimmt weiterhelfen ;-).
Ich habe eine Datenbank (Excel) mit Projekten (Name, Projektnummer, Status, etc.). Außerdem gibt es eine Word-Vorlage mit Textformularen.
Beim Start des Makros in Word kann der Projektmanager seine Projektnummer eingeben und bestimmte Daten (Name, Projektnummer, Status) sollen in das Worddokument (in die entsprechenden Textformulare) aus der Exceldatei übetragen werden.
Ich hab hier ein Code gefunden und angepasst. ABER ;-) die Werte werden nicht in ein Textformular eingefügt, sondern da wo der Kurser ist. Ich hab die Stelle mit dem Einfügen identifiziert aber hab leider keine Lösung wie ich den Code ändern soll damit der Wert z. B. "Name" (Zeille A) in Textformular1 und "Projektnummer" (Zeile B) in Textformular 2 einfügt wird. Hier mein Code
Option Explicit
Const ExcelDatei = "C:\Test.xls"
Const ExcelTabelle = "test"
Const AdrName = "A" 'Excel-Spalte Namen
Const AdrStr = "B" 'Excel-Spalte Projektnummer
Const AdrPlz = "C" 'Excel-Spalte Status
Const AdrOrt = "D" 'Excel-Spalte xxx
Const xlWhole = 1 'Excel-Konstanten
Const xlValues = -4163
Sub GetAddress()
Dim Search As String, Text As String
If CreateObject("Scripting.FileSystemObject").FileExists(ExcelDatei) = False Then
MsgBox "Die Excel-Datei wurde nicht gefunden!", vbExclamation, "Fehler"
Exit Sub
End If
Search = InputBox("Bitte eine Projektnummer eingeben", "Suchen")
If Search = "" Then Exit Sub
Text = GetExcelDaten(Search)
If Text = "" Then
MsgBox "Die Projektnummer wurde nicht gefunden!", vbInformation, "Suchergebnis"
Else
Selection.TypeText Text
End If
End Sub
Private Function GetExcelDaten(ByRef Search) As String
Dim Wks As Object, Found As Object
Set Wks = GetObject(ExcelDatei).Sheets(ExcelTabelle)
Set Found = Wks.Columns(AdrName).Find(Search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:= _
False)
If Not Found Is Nothing Then
With Wks.Rows(Found.Row)
GetExcelDaten = .Columns(AdrName) & vbCrLf & vbCrLf & _
.Columns(AdrStr) & vbCrLf & _
.Columns(AdrPlz) & " " & _
.Columns(AdrOrt) & vbCrLf & vbCrLf
End With
End If
Application.DisplayAlerts = False
GetObject(ExcelDatei).Close True
Application.DisplayAlerts = True
End Function