Hi everyone,
I've have this piece of code which I have edited for my own purposes but I am having a couple of issues. There are 2 things I can get it to do:
1. The bits that add in the titles for each section e.g.
WordApp.Selection.Collapse Direction:=wdCollapseStart
WordApp.Selection.TypeText Text:="BCM Plans" & vbCrLf
I want to somehow make these centred on the document and also change them to bold and increase their size
2. I want to have a message box or something equivalent at the end that asks if they would like to print the document and if yes to display the print menu - the code I have for this doesn't work.
Can anyone help with either of these? (I have attached the whole code at the bottom)
I've have this piece of code which I have edited for my own purposes but I am having a couple of issues. There are 2 things I can get it to do:
1. The bits that add in the titles for each section e.g.
WordApp.Selection.Collapse Direction:=wdCollapseStart
WordApp.Selection.TypeText Text:="BCM Plans" & vbCrLf
I want to somehow make these centred on the document and also change them to bold and increase their size
2. I want to have a message box or something equivalent at the end that asks if they would like to print the document and if yes to display the print menu - the code I have for this doesn't work.
Can anyone help with either of these? (I have attached the whole code at the bottom)
Code:
Sub CopyXLSDataToWorddoc()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim r
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
If Application.UserName = "MatthewW" Then
WordApp.Selection.Collapse Direction:=wdCollapseStart
WordApp.Selection.TypeText Text:="BCM Plans" & vbCrLf
Workbooks("Common Xl A").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "Contact Details" & vbCrLf & vbCrLf
'WordApp.Selection.InsertBefore "BCM Plan for Post Offer" & vbCrLf & vbCrLf
'WordApp.Selection.Collapse Direction:=wdCollapseStart
'WordApp.Selection.InsertAfter "Contact Details" & vbCrLf & vbCrLf
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl B"
Workbooks("Common Xl B").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "Battlebox Contents" & vbCrLf & vbCrLf
'WordApp.Selection.InsertAfter "Battlebox Contents" & vbCrLf & vbCrLf
Workbooks("Common Xl B").Close
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl C"
Workbooks("Common Xl C").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "Scenarios" & vbCrLf & vbCrLf
'WordApp.Selection.InsertAfter "Scenarios" & vbCrLf & vbCrLf
Workbooks("Common Xl C").Close
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl D"
Workbooks("Common Xl D").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "WAR Requirements" & vbCrLf & vbCrLf
'WordApp.Selection.InsertAfter "War Requirements" & vbCrLf & vbCrLf
Workbooks("Common Xl D").Close
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl E"
Workbooks("Common Xl E").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
'WordApp.Selection.InsertAfter "Recent changes" & vbCr & vbCr
Workbooks("Common Xl E").Close
End If
If Application.UserName = "RuthB" Then
Workbooks("Common Xl A").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.Collapse Direction:=wdCollapseStart
WordApp.Selection.TypeText Text:="BCM Plans" & vbCrLf
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "Contact Details" & vbCrLf & vbCrLf
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl B"
Workbooks("Common Xl B").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "Battlebox Contents" & vbCrLf & vbCrLf
'WordApp.Selection.InsertAfter "Battlebox Contents" & vbCrLf & vbCrLf
Workbooks("Common Xl B").Close
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl C"
Workbooks("Common Xl C").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteShape, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "Scenarios" & vbCrLf & vbCrLf
'WordApp.Selection.InsertAfter "Scenarios" & vbCrLf & vbCrLf
Workbooks("Common Xl C").Close
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl D"
Workbooks("Common Xl D").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
WordApp.Selection.Collapse Direction:=wdCollapseEnd
WordApp.Selection.TypeText Text:=vbCrLf & vbCrLf & "WAR Requirements" & vbCrLf & vbCrLf
Workbooks("Common Xl D").Close
Workbooks.Open Filename:="R:/BCM/BCM, RB and MW/BCM presentations/Common Xl E"
Workbooks("Common Xl E").Worksheets("Matt").Activate
Range(ActiveSheet.UsedRange.Address).Copy
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
WordApp.Selection.InsertBreak wdLineBreak
Workbooks("Common Xl E").Close
End If
r = MsgBox("Would you like to print this plan?", vbYesNo)
If r = vbYesNo Then
WordApp.Dialogs(wdDialogFilePrint).Display
Else: Exit Sub
End If
Set WordDoc = Nothing
Set WordApp = Nothing
End Sub