Data uit Word in Excel inlezen

[Klijhoofd]

Hallo,

Ik ben nieuw hier en ben sindskort bij een nieuwe werkgever veel met Excel bezig. Ik zit echter nu met het volgende probleem waar ik zelf niet uitkom.

Beschrijving:
Collega`s van mij hebben formats met tabellen in Word ingevuld en opgeslagen op SharePoint. Nu moeten de gegevens uit deze formats in Excel geplakt worden als platte tekst. Mijn voorganger heeft hiervoor een Macro gemaakt en dat heeft gewoon goed gewerkt voor fase 2 (formats 2). Nu we in fase 3 zijn aanbeland wil ik graag de gegevens uit de formats 3 in een nieuw werkblad importeren, maar dat werkt niet. Ik heb al wel de code van de Macro (van 2 naar 3) aangepast, maar ik krijg het niet voor elkaar. Zouden jullie mij kunnen helpen? In de bijlage heb ik een format (met fictieve data) geplakt. De Macro ziet er als volgt uit:

Sub ImportWordTable()
Application.Calculation = xlManual
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer
Dim iRow As Long
Dim jRow As Long
Dim iCol As Integer
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub
Set wdDoc = GetObject(wdFileName)
With wdDoc
If wdDoc.tables.Count = 0 Then
MsgBox "Dit document bevat geen tabellen", _
vbExclamation, "Import Word Tabel"
Else
jRow = 0
Sheets("Ruwe data Format 2").Select
Sheets("Ruwe data Format 2").Cells.Clear
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
For iRow = 1 To .Rows.Count
jRow = jRow + 1
For iCol = 1 To .Columns.Count
On Error Resume Next
ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
Next iRow
End With
jRow = jRow + 1
Next TableNo
End If
End With
Set wdDoc = Nothing
'Timestamp
Worksheets("Data Format 2").Calculate
Worksheets("Data Format 2").Range("A144") = "Laatste refresh"
Worksheets("Data Format 2").Range("C144") = Now()
Worksheets("Ruwe data Format 2").Range("H1") = "Laatste Macro Update"
Worksheets("Ruwe data Format 2").Range("I1") = Now()
'/Timestamp
Application.Calculation = xlAutomatic

End Sub


Ik hoop dat jullie mij kunnen helpen!

 

[vanveelen]

Hoi,

Het is volstrekt onduidelijk wat je wilt.
Het meegestuurde Word-document bevat meerdere tabellen met een verschillende indeling en inhoudelijke opzet.
Hiervoor is dus niet een uniform vba-script te maken.

Het meest eenvoudige is, elke tabel afzonderlijk te selecteren en in Excel in een map (=bestand) elk in een afzonderlijk werkblad te plaatsen.

VBA heeft - zoals gezegd - alleen zin als de tabellen allemaal hetzelfde zouden zijn en - minstens even belangrijk - vba gebruik je wanneer in steeds terugkomende situaties de bewerkingen opnieuw moeten worden toegepast. Hiervan is bij jou echter geen sprake: het gaat om een eenmalige actie.
Mijn advies dus: bespaar je de moeite. De tijd die je nu kwijt bent is ruimschoots gewonnen door eenmalig te kopiëren en te plakken.

 

[Klijhoofd]

Bedankt voor je antwoord. Het heeft toch echt gewerkt, maar je hebt wellicht gelijk dat het makkelijker is om de tabellen afzonderlijk te knippen en te plakken. De bewerkingen die ik daarin doe heb ik al in een macro, dus het is een kwestie van document openen, macra a draaien, naar Excel document en macro b draaien.

Ik loop nu alleen tegen een ander probleem aan. In de Word tabellen worden wel eens opsommingen gebruikt. Als ik die gegevens in Excel plak, dan gaat hij deze in meerdere regels plaatsen (overigens, soms in meerdere regels en soms niet). Dat is niet de bedoeling. Heb je een oplossing voor dat probleem? Het aantal regels per tabel moet namelijk exact gelijk zijn ivm de verwerking van de data.

 

[popipipo]

Wat is de reden dat je dit in excel wilt zetten?

Excel is een programma om mee te rekenen.
Word is een programma om tekst mee te verwerken.

Nu wil je teksten in excel plaatsen en gebruik je excel dus als tekstverwerker.
Dit is naar mijn mening onlogisch.