Office: Problem Von Word nach Excel Daten importieren excel2010

HI zusammen,

wie schon oben erwähnt habe ich den Auftrag bekommen aus Worddokumenten Teile zu entnehmen und diese dann in einer Exceltabelle einzufügen.
Ich formuliere meine Aufgabe mal etwas genauer:
1. Excel soll sich aus einen Worddoc durch eine Rechnungsnr. die in der Tabelle eingetragen wird, die Daten für gearbeitete Stunden,Netto,MwST und Brutto holen
und diese automatisch in die entsprechende Zeile einfügen.
2. Durch einen Synchro Button soll Excel den Zielordner ,indem die Rechnungen hinterlegt sind, durchsuchen und dann wie gesagt in 1. abarbeiten

da ich ein absoluter Anfänger in dem Umgang mit Vba und der tieferen Materie von Excel bin, hoffe ich das ich bei euch Hilfe finde.
Falls noch Informationen irgendeiner Art benötigt werden, dann lass es mich bitte wissen.

Grüße, Tim

 

Soo und Hi again,
nachdem mittlerweile 1 Monat vergangen ist und ich mich in dieser Zeit intensiever mit Vba und Excel beschäftigt habe nimmt das ganze solangsam Gestalt an.
Habe aber noch die ein oder andere Frage bei der ich hoffe das ihr mir helfen könnt.
Das Problem besteht für mich noch darin, dass wenn ich aus meinem Rechnungsdoc. das Datum in eine ExcelTabelle als Zahl ausgeben will das soweit funktioniert,
soweit in der Rechnung steht "Januar 2012" oder "September 2012" .
Sobald aber drinne steht "von Februar bis 10/2013" gibt er mit dafür einen Fehler aus, was ich auch verstehe.
Jetzt benötige ich eine schlaue Lösung die mir dann in diesem Falle macht / sagt, wenn "Januar bis Dezember" drinne steht dann ok, wenn nicht lass es einfach Frei und gehe zum nächsten.
Danke schonma Tim

Code:

Option Explicit

  Dim objWD As Object
  Dim oXcl As Object, xlWorkbook As Excel.Workbook, oIShape As InlineShape                                                               'Eintragen Variablen
  Dim iRow, iSpalte, oXclRow, iMonat                        As Long
  Dim strPfad, Text, wordText, einheit, strMonat            As String
  Dim letzteZeile, mengenZeile, Monat                       As Integer
  Dim summeStunden As Double, summeNetto, summeGesamt       As Double
 
Private Sub Synchronisieren()
   
Set xlWorkbook = Excel.ActiveWorkbook                                                                                                    'Eintragen in Wordformular
letzteZeile = Workbooks("Test(TEST).xls").Worksheets("Rechbuch").Range("E65336").End(xlUp).Row                                                  'zur Erkennung der zur letzten zu bearbeitenden Zelle
For iRow = 8 To letzteZeile Step 1                                                                                                       'Spaltenangabe in der Gesucht werden soll
summeStunden = 0#
summeNetto = 0#
einheit = "Std."
strPfad = "P:\Test\rec" & xlWorkbook.Sheets(1).Cells(iRow, 5).Value & ".doc"                                                            'Pfadangabe der Zieldateien
If Dir(strPfad) <> "" And xlWorkbook.Sheets(1).Cells(iRow, 5).Value <> "" Then                                                           'Schleife in der geschaut wird ob Datei da oder nicht
  Set objWD = CreateObject("Word.Application")
  objWD.Application.Documents.Open (strPfad)                                                                                             'Worddoc öffnen
  wordText = ersteZeile(objWD)
    Set oXcl = CreateObject("Excel.Sheet")                                                                                               'In Word die Excel Tabelle ansprechen/erstellen
      For Each oIShape In objWD.ActiveDocument.InlineShapes
        If InStr(1, oIShape.OLEFormat.progID, "Excel") Then
        oIShape.OLEFormat.Activate                                                                                                       'Übertrag aus Worddoc in Excelsheet
          Set oXcl = oIShape.OLEFormat.Object
           strMonat = oXcl.Sheets(1).Range("C6").Value  ' <-- um diese und nächste Zeile handelt es sich <
           Monat = Month(strMonat)
           mengenZeile = oXcl.Sheets(1).Range("B100").End(xlUp).Row                                                                       'Range in der er sich bewegen darf
            For oXclRow = 9 To mengenZeile
                If Len(oXcl.Sheets(1).Cells(oXclRow, 9).Value) > 1 Then
                    If oXcl.Sheets(1).Cells(oXclRow, 2).Value <> " " And oXcl.Sheets(1).Cells(oXclRow, 2).Value <> "" And oXcl.Sheets(1).Cells(oXclRow, 8).Value <> "" And oXcl.Sheets(1).Cells(oXclRow, 3).Value = "Std." Then         'Wenn Leerzeichen da dann 'Wenn Zahl da dann
                            summeStunden = summeStunden + oXcl.Sheets(1).Cells(oXclRow, 2).Value
                            summeNetto = summeNetto + (oXcl.Sheets(1).Cells(oXclRow, 2).Value * oXcl.Sheets(1).Cells(oXclRow, 8).Value)   'Stdn * Stdnlohn als Ausgabe
                            xlWorkbook.Sheets(1).Cells(iRow, 6).Value = summeStunden
                            xlWorkbook.Sheets(1).Cells(iRow, 7).Value = summeNetto
                            xlWorkbook.Sheets(1).Cells(iRow, 2).Value = oXcl.Sheets(1).Range("E1").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 4).Value = oXcl.Sheets(1).Range("G6").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 3).Value = wordText
                            xlWorkbook.Sheets(1).Cells(iRow, 1).Value = Monat
                         ElseIf oXcl.Sheets(1).Cells(oXclRow, 2).Value <> " " And oXcl.Sheets(1).Cells(oXclRow, 2).Value <> "" And oXcl.Sheets(1).Cells(oXclRow, 3).Value = "Std." Then
                            summeStunden = summeStunden + oXcl.Sheets(1).Cells(oXclRow, 2).Value                                          'wenn Preis leer dann auf Gesamt beziehen
                            summeGesamt = summeGesamt + oXcl.Sheets(1).Cells(oXclRow, 9).Value
                            xlWorkbook.Sheets(1).Cells(iRow, 7).Value = summeGesamt
                            xlWorkbook.Sheets(1).Cells(iRow, 6).Value = summeStunden
                            xlWorkbook.Sheets(1).Cells(iRow, 2).Value = oXcl.Sheets(1).Range("E1").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 4).Value = oXcl.Sheets(1).Range("G6").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 3).Value = wordText
                            xlWorkbook.Sheets(1).Cells(iRow, 1).Value = Monat
                        ElseIf oXcl.Sheets(1).Cells(oXclRow, 2).Value <> " " And oXcl.Sheets(1).Cells(oXclRow, 2).Value <> "" And oXcl.Sheets(1).Cells(oXclRow, 8).Value <> "" And oXcl.Sheets(1).Cells(oXclRow, 3).Value <> "Std." Then
                            summeGesamt = summeGesamt + oXcl.Sheets(1).Cells(oXclRow, 9).Value
                            xlWorkbook.Sheets(1).Cells(iRow, 7).Value = summeGesamt
                            xlWorkbook.Sheets(1).Cells(iRow, 2).Value = oXcl.Sheets(1).Range("E1").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 4).Value = oXcl.Sheets(1).Range("G6").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 3).Value = wordText
                            xlWorkbook.Sheets(1).Cells(iRow, 1).Value = Monat
                        ElseIf oXcl.Sheets(1).Cells(oXclRow, 2).Value <> "" Or oXcl.Sheets(1).Cells(oXclRow, 2).Value <> " " And _
                                oXcl.Sheets(1).Cells(oXclRow, 3).Value <> "Std." And oXcl.Sheets(1).Cells(oXclRow, 8).Value = "" Or _
                                oXcl.Sheets(1).Cells(oXclRow, 8).Value = " " Then                                                         'wenn Einheit / Std / Preis nicht vorhanden
                            summeGesamt = summeGesamt + oXcl.Sheets(1).Cells(oXclRow, 9).Value
                            xlWorkbook.Sheets(1).Cells(iRow, 7).Value = summeGesamt
                            xlWorkbook.Sheets(1).Cells(iRow, 2).Value = oXcl.Sheets(1).Range("E1").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 4).Value = oXcl.Sheets(1).Range("G6").Value
                            xlWorkbook.Sheets(1).Cells(iRow, 3).Value = wordText
                            xlWorkbook.Sheets(1).Cells(iRow, 1).Value = Monat
                        
                     End If
                End If
            Next
       End If
    Next oIShape
   objWD.Quit SaveChanges:=False                                                                                                          'Datei nach Schließung nicht speichern
End If
Set objWD = Nothing
Next                                                                                                                                      'Schleife fängt von neuem an
xlWorkbook.Save                                                                                                                           'Excelsheet speichern
Set xlWorkbook = Nothing

End Sub

Function ersteZeile(wdobj As Object) As String
    Dim foundFirstText As Boolean
    Dim foundStr As String
    
    wdobj.ActiveDocument.Range(0, 0).Select 'An den Anfang positionieren
    foundFirstText = False
    While Not wdobj.Selection.Bookmarks.Exists("\EndOfDoc") And Not foundFirstText 'Bis zum Ende des Dokumentes
        foundStr = wdobj.Selection.Bookmarks("\Line").Range.Text
        If Len(foundStr) > 1 Then
            foundFirstText = True
            ersteZeile = wdobj.Selection.Bookmarks("\Line").Range.Text
        End If
        wdobj.Selection.MoveDown Unit:=wdLine 'Zur nächsten Zeile positionieren
    Wend

End Function

 

Hallo Tim,

ich habe Dir dazu folgende Funktion gebastelt:

Code:

Function GetDatumTeile(DatumText As String, ByRef VonMonat As Integer, ByRef BisMonat As Integer, ByRef Jahr As Integer) As String
   Dim DatumTeile$(), Bis$
   On Error GoTo Err_GetDatumTeile
   GetDatumTeile = "": VonMonat% = 0: BisMonat% = 0: Jahr% = 0
   DatumTeile$ = Split(DatumText$, " bis ")
   If UBound(DatumTeile$) = 0 Then DatumTeile$ = Split(DatumText$, " - ")
   If UBound(DatumTeile$) = 0 Then DatumTeile$ = Split(DatumText$, "-")
   If UBound(DatumTeile$) = 1 Then
     'DatumText sieht so aus: "Januar bis Oktober 2012" oder "Januar bis 10/2012" oder "1 bis 10/2012" oder "1 bis Oktober 2012"
     'DatumText sieht so aus: "Januar - Oktober 2012"   oder "Januar - 10/2012"   oder "1 - 10/2012"   oder "1 - Oktober 2012"
     'DatumText sieht so aus: "Januar-Oktober 2012"     oder "Januar-10/2012"     oder "1-10/2012"     oder "1-Oktober 2012"
     Jahr% = Year(DatumTeile$(1))
     VonMonat% = Month(DatumTeile$(0) & " " & Jahr%)
     BisMonat% = Month(DatumTeile$(1))
     If VonMonat% > BisMonat% Then Err.Raise 13
   Else
     'DatumText sieht so aus: "Oktober 2012" oder "10/2012"
     Jahr% = Year(DatumTeile$(0))
     VonMonat% = Month(DatumTeile$(0))
     BisMonat% = VonMonat%
   End If
   Exit Function
Err_GetDatumTeile:
   GetDatumTeile = "Fehler " & Err.Number & ": " & Err.Description
End Function

Diese Funktion besitzt 4 Parameter und 1 Funktionsresultat:
1.Parameter: DatumText: Typ String: in diesem Parameter steht der zu analysierende Datumstext:
Beispiele für erlaubte String-Werte:
DatumText = "Januar bis Oktober 2012" oder "Januar bis 10/2012" oder "1 bis 10/2012" oder "1 bis Oktober 2012"
DatumText = "Januar - Oktober 2012" oder "Januar - 10/2012" oder "1 - 10/2012" oder "1 - Oktober 2012"
DatumText = "Januar-Oktober 2012" oder "Januar-10/2012" oder "1-10/2012" oder "1-Oktober 2012"
DatumText = "Oktober 2012" oder "10/2012"
Beispiele für unerlaubte String-Werte:
DatumText = "November bis Oktober 2012" oder "11-10/2012" oder "0-10/2012" oder "3-13/2012"
DatumText = "Mai 2012 bis Oktober 2012" oder "5/2012 bis 10/2012" oder "5/2012-6/2013"
Dieser Parameter ist in erster Linie ein Übergabeparameter an die Funktion.
Die folgenden Parameter sind Rückgabeparameter von der Funktion an das aufrufende Programm (deshalb "ByRef" -> "Call by Reference")
2.Parameter: VonMonat: Typ Integer: enthält die Nummer des Anfangsmonats aus DatumText
3.Parameter: BisMonat: Typ Integer: enthält die Nummer des Endemonats aus DatumText; falls kein "bis" oder "-" enthalten ist in DatumText, dann ist VonMonat=BisMonat.
4.Parameter: Jahr: Typ Integer: enthält die Jahreszahl aus DatumText
Die Funktion "GetDatumTeile" hat ein Funktionsresultat vom Typ String: Falls der Inhalt von DatumText korrekt/fehlerfrei analysiert werden konnte, dann ist der Rückgabestring ="", sonst enthält er die entsprechende Fehlermeldung.
Also, nur wenn der Rückgabewert der Funtkion ="", enthalten auch die 3 Rückgabeparameter VonMonat, BisMonat, Jahr gültige Werte.
Anwendungscodebeispiel:

Code:

Dim S$, V%, B%, J%, F$
F$ = GetDatumTeile("Januar bis Oktober 2012", V%, B%, J%)
If F$="" Then
  'DatumText ist korrekt -> Rückgabeparameter V, B, J enthalten gültige Werte und dürfen weiterverwendet werden:
   S$ = V & "-" & B & "/" & J   'in S$ steht dann: "1-10/2012"
Else
  'DatumText ist nicht korrekt -> in F$ steht die Fehlermeldung, zB. "Fehler 13: Typen unverträglich"
  'Die 3 Rückgabeparameter V, B, J enthalten ungültige Werte. 
EndIf

Was mir darüber hinaus beim Überfliegen Deines Codes aufgefallen ist, ist leider eine Falle für alle Programmierer, die von anderen Programmiersprachen her kommend, in VBA einsteigen: die Variablendeklarationen:
Dein Deklarationscode am Anfang liest sich:

Code:

  Dim objWD As Object
  Dim oXcl As Object, xlWorkbook As Excel.Workbook, oIShape As InlineShape                                                               'Eintragen Variablen
  Dim iRow, iSpalte, oXclRow, iMonat                        As Long
  Dim strPfad, Text, wordText, einheit, strMonat            As String
  Dim letzteZeile, mengenZeile, Monat                       As Integer
  Dim summeStunden As Double, summeNetto, summeGesamt       As Double

Er sollte vermutlich jedoch so lauten:

Code:

  Dim objWD As Object
  Dim oXcl As Object, xlWorkbook As Excel.Workbook, oIShape As InlineShape                                                               'Eintragen Variablen
  Dim iRow [COLOR=#ff0000]As Long[/COLOR], iSpalte [COLOR=#ff0000]As Long[/COLOR], oXclRow[COLOR=#ff0000] As Long[/COLOR], iMonat As Long
  Dim strPfad[COLOR=#ff0000] As String[/COLOR], Text[COLOR=#ff0000] As String[/COLOR], wordText[COLOR=#ff0000] As String[/COLOR], einheit[COLOR=#ff0000] As String[/COLOR], strMonat As String
  Dim letzteZeile[COLOR=#ff0000] As Integer[/COLOR], mengenZeile[COLOR=#ff0000] As Integer[/COLOR], Monat As Integer
  Dim summeStunden As Double, summeNetto[COLOR=#ff0000] As Double[/COLOR], summeGesamt As Double

Lässt man die vorhin roten Codeteile weg, so macht VBA aus diesen Variablen lauter Variablen vom Typ "Variant", die dann zur Runtime irgendeinen Subtypen erhalten je nach jeweiliger Codeumgebung. Das kann dann, wenn man an gewissen Stellen implizite Datenkonversionen beabsichtigte, zu falschen Resultaten oder gar Fehlermeldungen führen.
In VBA muss man jeder Variablen einzeln den Typ zuweisen entweder per Typsuffix oder mit "As TypeXY".
An Typsuffixen gibt es:
$ kennzeichnet String-Typen: zB. Dim strPfad$, Text$ oder aber Dim strPfad As String, Text As String
% kennzeichnet Integer-Typen
& kennzeichnet Long-Typen
! kennzeichnet Single-Typen
# kennzeichnet Double-Typen
@ kennzeichnet Currency-Typen
Für alle anderen Typen gibt es kein Typsuffix.

 

Hey Anton,
danke und wow für deine Antwort. Das mit der Variablendeklaration werde ich mir merken, war wieder was neues für mich :)
Komme erst am Montag dazu deine Funktion zu testen. Werde dir aber direkt mitteilen wie es läuft.
lg Tim