Kopieeren van Word naar Excel (Jaaroverzicht)

Status
Niet open voor verdere reacties.

evero

Gebruiker
Lid geworden
25 jul 2011
Berichten
31
Goedendag,

Op mijn werk maken wij rapportages van schades, letsels en diverse andere zaken.
Deze rapportages maken wij in Word. Om een overzicht te krijgen van bijvoorbeeld het aantal schade gevallen is het de bedoeling dat enkele zaken uit deze rapportage weggeschreven worden naar het Excel bestand “Jaaroverzicht” (met diverse bladen).

In een Word formulier heb ik enkele bladwijzers benoemd en iedere keer als dat formulier wordt afgesloten wil ik de benoemde bladwijzers weggeschreven hebben naar het Excel bestand “Jaaroverzicht” (dat niet geopend staat).
Bladwijzer “Nummer” moet naar kolom A in A2 en iedere volgende keer bij het afsluiten van het Word formulier een cel lager.
Bladwijzer “Datum”, “Tijd” en “Naam” moeten gelijktijdig in dezelfde rij meegaan als “Nummer”.

De VBA in het Word bestand doet wel zaken overschrijven naar Excel maar niet zoals ik dit voor ogen heb.
Een uitgekleed Word en Excel bestand heb ik als voorbeeld toegevoegd.
Gaarne jullie hulp, bij voorbaat dank hiervoor.

evero
 

Bijlagen

Gek dat niemand er nog naar gevraagd heeft: wat is het wachtwoord?
 
Het wachtwoord staat ook in het Word document en is 1234.
 
Had ik niet gezien :).

Ik zou in ieder geval met Early Binding werken, dan heb je het voordeel van IntelliSense. Je zult in je bestand de laatste rij moeten opzoeken en niet in een vaste rij werken, zoals je nu doet. Dat is logisch, toch?
Code:
    pad = ActiveDocument.Path
    Set ObjExcel = CreateObject("EXCEL.APPLICATION")
    Set ObjWorkBook = ObjExcel.Workbooks.Open(pad & "\Jaaroverzicht.xlsx")
    ObjExcel.Visible = True
    Set ObjWorksheet = ObjWorkBook.Worksheets("Letsels")
    With ObjWorksheet
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(LastRow, 1) = ActiveDocument.Bookmarks("Nummer").Range.Text
        .Cells(LastRow, 2) = ActiveDocument.Bookmarks("Datum").Range.Text
        .Cells(LastRow, 3) = ActiveDocument.Bookmarks("Tijd").Range.Text
        .Cells(LastRow, 4) = ActiveDocument.Bookmarks("Naam").Range.Text
    End With
    ObjWorkBook.Save
    ObjWorkBook.Close
    ObjExcel.Quit
    Set ObjExcel = Nothing
 
Hallo OctaFish,

Allereerst hartelijk dank voor uw hulp.
Ik moet eerlijk zeggen dat ik niet goed weet wat u bedoelt met Early Binding en IntelliSense. Dat van "De laatste rij opzoeken en niet in een vaste rij werken" klinkt inderdaad logisch.
Uw oplossing heb ik toegepast, echter deze loopt vast op:

Code:
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1

Ik heb zelf het idee dat ik ergens iets aan moet vinken om dit gedeelte werkend te krijgen.Ik werk met Microsoft Office 2010.
Enig idee hoe dit op te lossen?

evero
 
Goedendag,

Zoals ik al eerder zei loopt de VBA code niet goed door en stopt bij:

Code:
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1

Ik bedenk mij ook dat de gegeven oplossing mogelijk wel goed kan werken voor mijn eerder gegeven “probleem”,
echter ben ikzelf voorbij gegaan aan een punt wat in de praktijk regelmatig zal voorkomen.
In mijn Word formulier staan diverse bladwijzers maar niet alle bladwijzers zijn direct relevant voor iedere rapportage.
In de praktijk zouden, na het wegschrijven naar Excel, cellen in een regel leeg kunnen blijven.
Als ik de voorgestelde oplossing van OctaFish volg zouden zaken door kunnen gaan lopen omdat deze de eerste vrije cel in iedere kolom vult.
Omdat wij zeker niet meer dan 50 rapportages per jaar maken had ik gedacht iedere rapportage naar rij 50 weg te schrijven en daarna naar boven te laten verplaatsen naar de eerste vrije rij.
Dit moet volgens mij kunnen met onderstaande code:

Code:
Private Sub CommandButton1_Click()
    pad = ActiveDocument.Path
    Set ObjExcel = CreateObject("EXCEL.APPLICATION")
    Set ObjWorkBook = ObjExcel.Workbooks.Open(pad & "\Jaaroverzicht.xlsx")
    ObjExcel.Visible = True
    Set ObjWorksheet = ObjWorkBook.Worksheets("Letsels")
    With ObjWorksheet
        .Range("A" & 50) = ActiveDocument.Bookmarks("Nummer").Range.Text
        .Range("B" & 50) = ActiveDocument.Bookmarks("Datum").Range.Text
        .Range("C" & 50) = ActiveDocument.Bookmarks("Tijd").Range.Text
        .Range("D" & 50) = ActiveDocument.Bookmarks("Naam").Range.Text
        .Range ("A3:A50" & Cells(Rows.Count, 1).End(xlUp).Row)
        .SpecialCells(4).EntireRow.Delete
    End With
    ObjWorkBook.Save
    ObjWorkBook.Close
    ObjExcel.Quit
    Set ObjExcel = Nothing
End Sub

Ik krijg dan de volgende fout melding:

Compileerfout:
Sub of Function is niet gedefinieerd.

Iemand enig idee wat er fout is/wat ik verkeerd doe?

evero
 
Bij mij doet-ie het redelijk (1 x namelijk) mits je de verwijzing naar Excel uiteraard wel aanzet in <Extra>, <Verwijzingen> want deze code gebruikt Early Binding.
Code:
    pad = ActiveDocument.Path
    Set ObjExcel = CreateObject("EXCEL.APPLICATION")
    Set ObjWorkBook = ObjExcel.Workbooks.Open(pad & "\Jaaroverzicht.xlsx")
    ObjExcel.Visible = True
    Set ObjWorksheet = ObjWorkBook.Worksheets("Letsels")
    With ObjWorksheet
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(LastRow, 1) = ActiveDocument.FormFields("Nummer").Result
        .Cells(LastRow, 2) = ActiveDocument.FormFields("Datum").Result
        .Cells(LastRow, 3) = ActiveDocument.FormFields("Tijd").Result
        .Cells(LastRow, 4) = ActiveDocument.FormFields("Naam").Result
    End With
    ObjWorkBook.Save
    ObjWorkBook.Close
    ObjExcel.Quit
    Set ObjExcel = Nothing
Ik ben nog even aan het uitzoeken waarom hij het de tweede keer niet doet. Overigens heb ik geen losse bladwijzers gebruikt, maar de bladwijzernamen die de tekstvakken toch al hebben. Dus waarom zou je die ook niet gebruiken? Dan kun je namelijk ook makkelijk gelijk de waarden van de tekstvelden uitlezen.
 
Code:
Sub M_snb()
  with getobject(ActiveDocument.Path & "\Jaaroverzicht.xlsx")
       .sheets("Letsels").cells(rows.count,1).end(-4162).offset(1).resize(,4)=array(ActiveDocument.FormFields("Nummer").Result,ActiveDocument.FormFields("Datum").Result,ActiveDocument.FormFields("Tijd").Result,ActiveDocument.FormFields("Naam").Result)
    .Close -1
  end with
End Sub
 
Beide heren hartelijk dank voor de reactie.

@SNB - Ik weet niet goed waar ik uw code moet plaatsen om deze werkend te krijgen.
Met wat ik tot op heden geprobeerd heb doet deze niet naar wat ik voor ogen heb.

@OctaFish - De door u gemelde verwijzing heb ik aangebracht.
Code werkt inderdaad maar één keer.
Dank alvast dat u gaat uitzoeken waarom de code een tweede keer niet werkt.
Ik verneem graag uw oplossing

Groet,
evero
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan