Formatting Word doc from Excel macro

Hiker

New Member
Joined
Jun 15, 2011
Messages
33
Office Version
  1. 2013
Platform
  1. Windows
Although I've been able to edit the existing macros some in a membership workbook I took over I know little to nothing about formatting the end product.

The current macro produces these forms

Registration_Page_2.jpg

but I'd like to design it to do this

Registration_Page_1.jpg


basically, adding the logo and text box, along with lining up the dollar amount columns, and spacing between lines.

PS I copied the macro into a txt file but don't see a way to attach it.
 
Last edited:

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
I'm getting closer to what I'm looking for. can anyone tell me how to indent a paragrapgh. I haven't tried but I found
.IndentLevel = n, where m = numbers of spaces. After that I'd need a same line command to push the text to the right, and a way to insert and aline the logo and text box.

RegFormEx.jpg
 
Upvote 0
Instead of building the doc on the fly, save the Word doc as a template. Put the data into a table, turn off borders, then only turn on the ones you need. Avoid merged cells if possible. Then, you can insert a bookmark into the cells and write to the bookmark.

Code:
With ActiveDocument.Paragraphs(1)
   .Indent.Indent 
End With
 
Last edited:
Upvote 0
Instead of building the doc on the fly, save the Word doc as a template. Put the data into a table, turn off borders, then only turn on the ones you need. Avoid merged cells if possible. Then, you can insert a bookmark into the cells and write to the bookmark.

Code:
With ActiveDocument.Paragraphs(1)
   .Indent.Indent 
End With

Thanks, I appreciate the help. I'll check it out.
 
Upvote 0
Just so you know, here's what I'm dealing with. I didn't write any of it except for some basic manipulation and I'm pretty much lost. When I change any formatting and/or run the macro it produces a 1200 page Word doc.

Code:
Sub MakeRegistrationForms()


' Creates Word document with one sheet for each member
' This assumes the worksheet only contains the members to include in the directory
'
' For some reason, the sort portion of this macro is failing so it is currently
' commented out until I get to try this again on another machine.
'
' In 2010, I separated the about to expire from the rest and printed them on
' yellow to draw attention to them. -MF


    Application.ScreenUpdating = False
    Dim WordApp As Object
    
    Dim DataOption1
    
    Const wdPageBreak = 7


    ' Start Word and create an object
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Documents.Add
    End With


    ' Determine the file name
    saveasname = ThisWorkbook.Path & "\" & "RegForms.doc"


    Dim MemberSheet
    MemberSheet = "Members"
    Dim NameCol
    NameCol = "lastfirst"
    Dim Address1Col
    Address1Col = "address1"
    Dim Address2Col
    Address2Col = "address2"
    Dim CityCol
    CityCol = "city"
    Dim StateCol
    StateCol = "state"
    Dim CodeCol
    CodeCol = "postalcode"
    Dim CountryCol
    CountryCol = "country"
    Dim RenewCol
    RenewCol = "notice"
    Dim Phone1Col
    Phone1Col = "phone1"
    Dim Phone2Col
    Phone2Col = "phone2"
    Dim Email1Col
    Email1Col = "email1"
    Dim Email2Col
    Email2Col = "email2"
    Dim TnameCol
    TnameCol = "trailname"
    Dim TrailsCol
    TrailsCol = "trails"
    Dim GatheringCol
    GatheringCol = "12Gathering"
    Dim PDFCol
    PDFCol = "PDF"
    
    ' Select the membership worksheet
    Sheets(MemberSheet).Select


    ' Determine the last row and column of the worksheet
    lr = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    lc = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
    
    ' Determine the column numbers for the membership data to be
    ' included in the Membership Index
    For i = 1 To lc
        Select Case Worksheets(MemberSheet).Cells(1, i).Value
            Case NameCol
                nc = i
            Case Address1Col
                a1c = i
            Case Address2Col
                a2c = i
            Case CityCol
                cic = i
            Case StateCol
                sc = i
            Case CodeCol
                zc = i
            Case CountryCol
                coc = i
            Case RenewCol
                rc = i
            Case Phone1Col
                p1c = i
            Case Phone2Col
                p2c = i
            Case Email1Col
                e1c = i
            Case Email2Col
                e2c = i
            Case TnameCol
                tnc = i
            Case TrailsCol
                tc = i
            Case GatheringCol
                gc = i
            Case PDFCol
                pdfc = i
        End Select
    Next i
    
    ' The following sort call worked on Scott's machine but not Benson's.  I left it
    ' in in case it works on another machine.
    
    ' Sort the entire spreadsheet by the names column
    'Range(Cells(1, 1), Cells(lr, lc)).Sort Key1:=Cells(1, nc), Order1:=xlAscending, _
        header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom, DataOption1:=xlSortNormal


    ' Loop through all members to generate index information
    For i = 2 To lr
        ' trap each piece of worksheet information
        Name = Cells(i, nc).Value & vbCrLf
        address1 = Cells(i, a1c).Value
        address2 = Cells(i, a2c).Value
        city = Cells(i, cic).Value
        State = Cells(i, sc).Value
        zip = Cells(i, zc).Value
        country = Cells(i, coc).Value
        renewal = Cells(i, rc).Value
        phone1 = Cells(i, p1c).Value
        phone2 = Cells(i, p2c).Value
        email1 = Cells(i, e1c).Value
        email2 = Cells(i, e2c).Value
        tname = Cells(i, tnc).Value
        trails = Cells(i, tc).Value
        gathering = Cells(i, gc).Value
        pdf = Cells(i, pdfc).Value


        ' Format each line of information for the Word document
        If address1 <> "" Then
            Address = address1
            If address2 <> "" Then
                Address = Address & vbCrLf & address2 & vbCrLf
            Else
                Address = Address & vbCrLf
            End If
        Else
            Address = vbCrLf & "Address: ______________________________" & vbCrLf
        End If
        csz = city & ", " & State & "  " & zip
        If csz = ",   " Then
            csz = vbCrLf & "City, State, Zip: ______________________________" & vbCrLf
        Else
            csz = csz & vbCrLf
        End If
        If country <> "" Then
            country = country & vbCrLf
        Else
            country = "" & vbCrLf
        End If
        renewalnote = "Your membership is " & renewal & "." & vbCrLf & vbCrLf
        If phone1 <> "" Then
            phone1 = phone1 & vbCrLf
        Else
            phone1 = "Phone: ______________________________" & vbCrLf
        End If
        If phone2 <> Empty Then
            phone2 = phone2 & vbCrLf
        Else
            phone2 = "" & vbCrLf
        End If
        If email1 <> "" Then
            email1 = email1 & vbCrLf
        Else
            email1 = vbCrLf & "Email: ______________________________" & vbCrLf
        End If
        If email2 <> "" Then
            email2 = email2 & vbCrLf
        Else
            email2 = "" & vbCrLf
        End If
        dqt = Chr(34) ' double quote symbol
        If tname <> "" Then
            tname = dqt & tname & dqt & vbCrLf & vbCrLf
        Else
            tname = "_____________________________" & vbCrLf & vbCrLf
        End If
        If trails <> "" Then
            trails = "Trails completed: " & trails & vbCrLf & vbCrLf
        Else
            trails = vbCrLf & "Trails completed: _____________________________" & vbCrLf & vbCrLf
        End If
        If gathering <> "" Then
            gathering = "      Number of prepaid registrants: " & gathering & vbCrLf
        Else
            gathering = "      Number of prepaid registrants: 0" & vbCrLf & vbCrLf
        End If
        If pdf <> "" Then
            pdf = "Thank you for choosing to receive your newsletters in PDF format.  "
        Else
            pdf = "_____ Check here to receive your newsletters in PDF format.  "
        End If
        
        


        ' Send commands to Word and write each line of data to file
        With WordApp
        With .Selection
            .TypeParagraph
            .Font.Name = "Arial"
            .Font.Size = 14
            .Font.Bold = True
            .ParagraphFormat.Alignment = 1
            .typetext Text:="Welcome to the ALDHA Gathering!"
            .TypeParagraph
            .TypeParagraph
            
            .typetext Text:="This is YOUR membership record with ALDHA:"
            .TypeParagraph
            .TypeParagraph
            .Font.Size = 12
            .ParagraphFormat.Alignment = 0
            .typetext Text:="Is the information below correct?    If NOT, please note changes here:"
            .TypeParagraph
            .TypeParagraph
            .Font.Size = 12
            .Font.Bold = True
            
            .typetext Text:=Name
            .Font.Bold = False
            .Font.Size = 11
            .typetext Text:=Address
            .typetext Text:=csz
            .typetext Text:=country
            .typetext Text:=phone1
            .typetext Text:=phone2
            .typetext Text:=email1
            .typetext Text:=email2
            .typetext Text:=vbCrLf & "Trail name(s): "
            .Font.Italic = True
            .typetext Text:=tname
            .Font.Italic = False
            .typetext Text:=trails
            
            .Font.Bold = True
            
            .typetext Text:=renewalnote
            If renewal <> "PAID THROUGH LIFE" And renewal <> "HONORARY LIFE MEMBER" Then
                .ParagraphFormat.Alignment = 3
                .typetext Text:="Membership renewals "
                .Font.Bold = False
                .typetext Text:="are $10 per calendar year per individual or household," & vbCrLf & vbCrLf
                .Font.Bold = True
                .typetext Text:="Lifetime Memberships "
                .Font.Bold = False
                .typetext Text:="are $200, and do not include yearly Gathering fees" & vbCrLf & vbCrLf
                .ParagraphFormat.Alignment = 2
                .typetext Text:="      Number of years: ________ x $10 per year = $_________" & vbCrLf & vbCrLf
                .typetext Text:="      Lifetime membership is $200  $_________" & vbCrLf & vbCrLf
            End If
            .Font.Bold = True
            .ParagraphFormat.Alignment = 3
            .typetext Text:="Gathering registration "
            .Font.Bold = False
            .typetext Text:="is $20.00 per person, or $50 for a family of 3 or more. (kids over 13)" & vbCrLf & vbCrLf
            .ParagraphFormat.Alignment = 1
            .typetext Text:=gathering
            .ParagraphFormat.Alignment = 2
            .typetext Text:="      Number of registrants paid for today: ________ x $20 per person = $_________" & vbCrLf & vbCrLf
            .ParagraphFormat.Alignment = 2
            .typetext Text:="      Amount of donation $_________" & vbCrLf & vbCrLf
            .Font.Bold = True
            .typetext Text:="Total paid to ALDHA today:  $_________" & vbCrLf & vbCrLf & vbCrLf
            .Font.Bold = False
            .ParagraphFormat.Alignment = 1
            .Font.Bold = True
            .typetext Text:="Donations to ALDHA"
            .Font.Bold = False
            .typetext Text:=", a registered 501(c)3 non-profit organization, are tax deductible." & vbCrLf & vbCrLf
            .typetext Text:="Make checks payable to ALDHA." & vbCrLf & vbCrLf
            .Font.Bold = True
            .typetext Text:=pdf
            .Font.Bold = False
            .typetext Text:="PDF newsletters arrive earlier, in full color, are better for the environment, and help keep ALDHA's expenses down." & vbCrLf & vbCrLf
            
            
            .InsertBreak Type:=wdPageBreak
            
        End With
        End With


    Next i


    With WordApp
        .ActiveDocument.SaveAs Filename:=saveasname
        .ActiveWindow.Close
    End With


    Set WordApp = Nothing
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
I realize you inherited this.

Nothing in the code is standing out.

If you can send me (my username at gmail) a sample membership workbook, and a completed membership form, I can demonstrate what I'm talking about.

To post the files here, you'll need to use a file sharing service like Box.com or Google docs to post a link.
 
Upvote 0

Forum statistics

Threads
1,214,653
Messages
6,120,750
Members
448,989
Latest member
mariah3

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