Sending information from excel to word - formatting issue!

Pasty

Board Regular
Joined
Mar 26, 2007
Messages
96
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)


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
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Re: Sending information from excel to word - formatting issu

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

Something like this should work:
Code:
    With WordApp.Selection
       .Collapse Direction:=wdCollapseStart
       .ParagraphFormat.Alignment = wdAlignParagraphCenter
       .Font.Bold = True
        .TypeText (Text:="BCM Plans" & vbCrLf)
       .Font.Bold = False
    End With

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.

Code:
    r = MsgBox("Would you like to print this plan?", vbYesNo)
    If r = vbYesNo Then
    WordApp.Dialogs(wdDialogFilePrint).Display
    Else: Exit Sub
    End If

Here, you want
Code:
 If r=vbYes then
WordApp.Dialogs(wdDialogFilePrint).Show
vbYes is the value for the Yes button, and while .Display shows the printing dialog, .Show both shows it and performs the deeds portrayed in it.
 
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,728
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top