AW: Daten von WORD nach EXCEL
20.04.2010 07:51:30
WORD
Hallo Andre,
die entsprechenden Anweisungen kannst du in die Prozedur einbauen, die die Formulardaten ins Worddokument einträgt.
Nachfolgend ein Beispiel.
Bei Zahlen- und Datumswerten sollten diese ggf. vor dem Einfügen in Excel konvertiert werden, damit die Information in Excel nicht als Text in den Zellen steht.
Wenn du in einem größeren Netzwerk arbeitest, dann kann das Speichern der Daten in Excel etwas dauern.
Gruß
Franz
Private Sub CommandButton1_Click()
'Eintragen Formuardaten und Speichern in Exceldatei
Dim oDoc As Document, oRange As Word.Range
Dim xlApp As Object, xlWorkbook As Object, xlsheet As Object, lZeile As Long
'Name der Exceldatei
Const sExcelfile As String = "C:\Users\Public\Test\WordDataBank.xls"
'Eintragen in Wordformular - Beispielhaft, sollte ja schon funktionieren
Set oDoc = ActiveDocument
With oDoc
Selection.GoTo What:=wdGoToBookmark, Name:="Textmarke1"
Selection.TypeText Text:=Me.TextBox1
Selection.GoTo What:=wdGoToBookmark, Name:="Datum1"
If IsDate(Me.TextBox2.Text) Then
Selection.TypeText Text:=Format(CDate(Me.TextBox2.Text), "YYYY-MM-DD")
Else
Selection.TypeText Text:=Me.TextBox2
End If
Selection.GoTo What:=wdGoToBookmark, Name:="Wert1"
If IsNumeric(Me.TextBox3.Text) Then
Selection.TypeText Text:=Format(CDbl(Me.TextBox3.Text), "#,##0.00")
Else
Selection.TypeText Text:=Me.TextBox3.Text
End If
'usw.
End With
'Eintragen in Exceldatenbank
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbook = xlApp.workbooks.Open(FileName:=sExcelfile)
Set xlsheet = xlWorkbook.Worksheets(1)
With xlsheet
'letzte Datenzeile
lZeile = .Cells.specialcells(11).Row + 1 'xlcelltypelastcell
.Cells(lZeile, 1).Value = Me.TextBox1.Text
If IsDate(Me.TextBox2.Text) Then
.Cells(lZeile, 2).Value = CDate(Me.TextBox2.Text)
Else
.Cells(lZeile, 2).Value = Me.TextBox2
End If
If IsNumeric(Me.TextBox3.Text) Then
.Cells(lZeile, 3).Value = CDbl(Me.TextBox3.Text)
Else
.Cells(lZeile, 3).Value = Me.TextBox3.Text
End If
End With
xlWorkbook.Save
xlWorkbook.Close
xlApp.Quit
Set xlsheet = Nothing: Set xlWorkbook = Nothing: Set xlApp = Nothing
Set oDoc = Nothing
End Sub