简体   繁体   中英

Excel to Word using VBA: Change font format and insert page break after every paste

Using a FOR loop, I'm trying to insert a pagebreak after every time I paste something from excel to word using VBA . However, all the page breaks appear BEFORE the pasted values. Also, I'd like to have the values centered in the middle. Can someone help with the code? Below is my code on VBA:

Sub movedatatoMSword()
Dim wApp    As Word.Application
Dim wDoc    As Word.Document
Dim ws      As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet3")

Set wApp = CreateObject("word.application")
wApp.Visible = True
Set wDoc = wApp.Documents.Add

For i = 1 To ws.Range("I4").Value
    Sheet3.Range("B4").Copy
    With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
        .Paste
        .Font.Name = "Ariel"
        .Font.Bold = True
        .Font.Allcaps = True
        .Font.Size = 60

        'Page Break
        With wApp.Selection
            .Collapse Direction:=0
            .InsertBreak Type:=7
        End With
    End With

Next i
End Sub

You're targeting a Range when you paste, which is good. But you're collapsing the Selection , which will not have moved when you paste to a Range . Since you're inserting the breaks at the Selection, they're all at the beginning, where the selection is when a document is opened.

There are two basic approaches you can use easily with this code: 1) select the Range to which you pasted, then collapse that or 2) use a Range variable throughout, without selecting. For example

Sub movedatatoMSword()
Dim wApp    As Word.Application
Dim wDoc    As Word.Document
Dim ws      As Worksheet
Dim i as Long
Dim rngTarget as Word.Range
Set ws = ThisWorkbook.Sheets("Sheet3")

Set wApp = CreateObject("word.application")
wApp.Visible = True
Set wDoc = wApp.Documents.Add
Set rngTarget =  wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
For i = 1 To ws.Range("I4").Value
    Sheet3.Range("B4").Copy
    With rngTarget
        .Paste
        .Font.Name = "Arial"
        .Font.Bold = True
        .Font.Allcaps = True
        .Font.Size = 60

        'Page Break
        .Collapse Direction:=0
        .InsertBreak Type:=7
        .Collapse Direction:=0
    End With

Next i
End Sub

Note that I

  • corrected the spelling of the font name (Arial)
  • declared the counter variable i (you should put Option Explicit at the top of your code module!)

Pasting a cell from Excel to Word means a box will be pasted rather than just the text (but maybe that's what you want). If you want to paste only the text, change:

Sheet3.Range("B4").Copy
With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
    .Paste

to :

 With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
.Text = Sheet3.Range("B4").Value

Then to center and move to end of text use:

wApp.Selection.Paragraphs(1).Alignment = 1
wApp.Selection.EndKey Unit:=wdStory

Okay so here should be a final version of what you are looking for. I think it's important to note that you cannot select the third sheet by saying sheet3 especially when you have already created set ws = ThisWorkbook.Sheets("Sheet3") . In those cases you would specify the sheet using ws .

Hopefully I otherwise covered all of the other requests that you had!

Sub MoveDataToMsWord()

    Dim wApp As Object
    Set wApp = CreateObject("word.application")
    wApp.Visible = True

    Dim wDoc As Object
    Set wDoc = wApp.Documents.Add

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet3")

    For i = 1 To ws.Range("I4").value
        With wDoc.Paragraphs(wDoc.Paragraphs.count).Range
            .Text = ws.Range("B4").value & vbCrLf & ws.Range("R3").value

            With .Font
                .Name = "Arial"
                .Bold = True
                .Allcaps = True
                .Size = 60
            End With

            'Center the paragraph
            .Paragraphs.Alignment = 1

            'Page Break
            .Collapse Direction:=0
            .InsertBreak Type:=7

            'Move cursor to end of document
            .Select
            Selection.EndKey Unit:=6

        End With
    Next i
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM