Copy an excel table and paste it into word

[Paskie_EU]

Hi,
I have devised this Word dotm document that features an interface inviting users to enter certain data, then click on the button to generate their document. Each piece of information is then fed at specific bookmarks in the word document. The last bookmark should receive the content of an excel worksheet that matches info n°1 provided. This info n°1 is the name of a distribution list that corresponds to the matching worksheet in the excel workbook. In this preliminary stage 1, I could get the rough info to be inserted at the correct bookmark. Preliminary stage 2 intended to copy the information of worksheet 1 of the excel workbook into the word document at the last bookmark. Sadly, this does not seem to work at all. Excel seems to get stuck at opening the document.

Now, I am not sure how to get out of this, nor do I seem to be able to upload the documents.

I'll just copy in the coding after this message.

Thanks,

P.

Private Sub CommandButtonEVTEUCI_Click()
With ActiveDocument.PageSetup
.PaperSize = wdPaperA4
.TopMargin = CentimetersToPoints(2.54)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2.54)
.BottomMargin = CentimetersToPoints(2.54)
End With

Dim DistriList As List
Dim index As Integer
index = -1

Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim oWS As Worksheet
Set oWB = Excel.Workbooks.Open("Y:\EUMS3\0600-Information Management\0610-Distribution Lists\New 2022\Data.xlsx")
Set oWS = oWB.Worksheets("Common EU-C & EU-S Docs")
'Dim wbBook As Workbook
'Dim wsSheet As Worksheet

oExcel.Active

GetExcelData
oWB.Close

PasteDataAndGenerateTable

With ActiveDocument
.Bookmarks("BkDLTitle").Range.Text = ComboBoxWhichDL.Value
.Bookmarks("BkDocClassification").Range.Text = ComboBoxDocClassification.Value


Dim LabelDocTitle As Range
Set LabelDocTitle = ActiveDocument.Bookmarks("BkDocTitle").Range
LabelDocTitle.Text = Me.TextBoxDocTitle.Value
Dim LabelDocRegistration As Range
Set LabelDocRegistration = ActiveDocument.Bookmarks("BkDocRegistration").Range
LabelDocRegistration.Text = Me.TextBoxDocRegistration.Value
Dim LabelDocReference As Range
Set LabelDocReference = ActiveDocument.Bookmarks("BkDocReference").Range
LabelDocReference.Text = Me.TextBoxDocReference.Value

End With
Me.Repaint
TestDistriList.Hide
End Sub
Private Sub userform_initialize()

ComboBoxWhichDL.List = Array("", "Common EU-C & EU-S Documents", "DG EUMS Report to EUMC", "EUMC EU-C & EU-S Documents", "EUMC EU-C Ukraine Presentations", "EUMC EU-C Presentations", "EUFOR ALTHEA EU-C & EU-S Documents", "EUNAVFOR IRINI EU-C & EU-S Documents", "All Operations and Missions EU-C & EU-S Documents", "All Operations and Missions EU-R Documents", "PSC EUFOR ALTHEA Documents", "PSC other Operations & Missions Documents")
ComboBoxDocClassification.List = Array("", "RESTREINT UE/EU RESTRICTED", "CONFIDENTIEL UE/EU CONFIDENTIAL", "SECRET UE/EU SECRET")

End Sub

Public Sub GetExcelData()

Dim tempStr As String
tempStr = ""
Dim row As Integer
row = 1

While tempStr <> "zzz"

zindex = zindex + 1
ReDim Preserve zDList(zindex) As DLClass
Set zDList(zindex) = New DLClass

Range("A" + CStr(row)).Select
zDList(zindex).Salutation = ActiveCell.Text

Range("B" + CStr(row)).Select
zDList(zindex).Name = ActiveCell.Text

Range("C" + CStr(row)).Select
zDList(zindex).Location = ActiveCell.Text

row = row + 1

Range("A" + CStr(row)).Select
tempStr = ActiveCell.Text

Wend

End Sub

Public Sub FindAndReplace(zfind As String, rreplace As String)

With Selection.Find
.Text = zfind
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With

Selection.Find.Execute
Selection.Delete

Selection.TypeText zreplace

End Sub
Public Sub PasteDataAndGenerateTable()

Dim counter As Integer
Dim middleList As Integer
middleList = 20

Dim optable As Table
Dim oprange As Range

Dim rownumber As Integer

Selection.GoTo what:=wdGoToBookmark, Name:="BkDistriList"
Selection.Copy

Selection.GoTo what:=wdGoToBookmark, Name:="BkDistriList2"
Selection.MoveUp unit:=wdLine, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph

Selection.Paste

Selection.MoveUp unit:=wdLine, Count:=5

With Selection.Find
.Text = "[[[Section Table]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute
Selection.Delete

Dim startIndex As Integer
Dim endIndex As Integer

If counter = 1 Then
startIndex = 0
endIndex = middleIndex * 2
End If

ActiveDocument.Tables.Add Selection.Range, 1, 3
ActiveDocument.Tables(counter).Range.ParagraphFormat.SpaceAfter = 3
ActiveDocument.Tables(counter).Range.ParagraphFormat.SpaceBefore = 3
ActiveDocument.Range.Font.Size = 9
ActiveDocument.Tables(counter).Columns(1).Width = 90
ActiveDocument.Tables(counter).Columns(2).Width = 90
ActiveDocument.Tables(counter).Columns(3).Width = 90

'ActiveDocument.Tables(counter).Rows(1).Range.Font.Bold = 1
'ActiveDocument.Tables(counter).Rows(1).Shading.BackgroundPatternColor = wdColorGray25

rownumber = 1
For i = startIndex To endIndex - 1
ActiveDocument.Tables(counter).Rows.Add
rownumber = rownumber + 1
ActiveDocument.Tables(counter).Rows(rownumber).Cells(1).Range.Text = zlist(i).Salutation
ActiveDocument.Tables(counter).Rows(rownumber).Cells(2).Range.Text = zlist(i).Name
ActiveDocument.Tables(counter).Rows(rownumber).Cells(3).Range.Text = zlist(i).Location
Next

Selection.Tables(1).Select
Selection.Collapse WdCollapseDirection.wdCollapseStart
Selection.MoveUp unit:=wdLine, Count:=1, Extend:=wdMove
Selection.EndKey unit:=wdLine, Extend:=wdMove
Selection.TypeText Text:=vbCrLf
Selection.InsertCaption wdCaptionLableID.wdCaptionTable, "Distribution List", "auto text"

With ActiveDocument.Tables(counter).Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.Color = wdColorBlack
.LineWidth = wdLineWidth100pt
End With
With ActiveDocument.Tables(counter).Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.Color = wdColorBlack
.LineWidth = wdLineWidth100pt
End With
With ActiveDocument.Tables(counter).Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.Color = wdColorBlack
.LineWidth = wdLineWidth100pt
End With
With ActiveDocument.Tables(counter).Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.Color = wdColorBlack
.LineWidth = wdLineWidth100pt
End With
With ActiveDocument.Tables(counter).Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.Color = wdColorBlack
.LineWidth = wdLineWidth100pt
End With
With ActiveDocument.Tables(counter).Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.Color = wdColorBlack
.LineWidth = wdLineWidth100pt
End With
Next
End Sub



Public Sub AutoTextToBM(strbmName As String, oTemplate As Template, strAutotext As String)
Dim orng As Range
On Error GoTo lbl_Exit
With ActiveDocument
Set orng = .Bookmarks(strbmName).Range
Set orng = oTemplate.AutoTextEntries(strAutotext).Insert(where:=orng, RichText:=True)
.Bookmarks.Add Name:=strbmName, Range:=orng
End With
lbl_Exit:
Exit Sub
End Sub

 

[Macropod]

You have a lot of unnecessary code there. For starters, you should be creating your base document from a Word template that has the required page setup and all the boilerplate content in-situ. You already have the bookmarks in-situ, so why not the page layout, the desired table, etc.? Furthermore, lines like:

Dim LabelDocTitle As Range
Set LabelDocTitle = ActiveDocument.Bookmarks("BkDocTitle").Range
LabelDocTitle.Text = Me.TextBoxDocTitle.Value

could all be reduced to:

.Bookmarks("BkDLTitle").Range.Text = ComboBoxWhichDL.Value

and the like.

You also have multiple unqualified references to Range, Selection, etc. Unless qualified, your macro will interpret those in terms of the calling application (in this case Word). Instead of:

GetExcelData

you should have something like:

Call GetExcelData(oWS)

and, in GetExcelData:

Public Sub GetExcelData(oWS As Excel.Worksheet)

together with oWS.Range instead of just Range in that sub wherever you're now using the latter. But, given what I'm posting below, you'll see that you don't actually need this sub.

When it comes to copying the information of worksheet 1 of the excel workbook into the word document, all you would need to do if you have the basic table in place in Word is to copy the entire Excel range then use Word's PasteAppendTable method, which will add however many rows are needed in the paste action itself.

PS: When posting VBA code, please use the VBA code tags, as indicated on the posting menu. Without them, your code loses much of whatever structure it had.

 

[Paskie_EU]

OK. Cheers. I'll look into that later this week as some emergencies have crept up.

Thanks.