Excel to Word

[kreitzig]

I am having some difficulty working out a few of the issues in my code and I'm hoping someone may be able to assist.

1. At section marked 'Name, address, contact' - I want the hyperlink to be in a different font (Times New Roman and bold, if that makes any difference).
2. At section marked 'Send commands To Word' - My PageSetup is not being applied to the document.
3. At section marked 'data' - I had tried using tabstops to position some text at 3.5", but it didn't work out well. Is there a way to position the text over without using tabstops?

Here is my code:

Sub AddData2()
'   Creates Word document
Dim WordApp As Object
Dim LastRow As Integer, i As Integer, r As Integer, Records As Integer
 
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
'data sort -- will need for For/i loop to begin after this statement
' Cycle through all records on Sheet1
Records = ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To Records
'   Start Word And create an Object
Set WordApp = CreateObject("Word.Application")
With WordApp
    .Documents.Add
End With
 
'   Determine the file name
SaveAsName = ThisWorkbook.Path & "\" & "Test-" & i & ".docx" 'replace with company/city/state

' Information from worksheet
Set Data = Sheets("Sheet1").Range("A2")
 
    ' Update status bar progress message
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Processing Record " & i & " of " & Records
     
    ' Assign current data To variables
    APPLICANT = Data.Offset(i - 1, 0).Value 'letter
    CITY = Data.Offset(i - 1, 1).Value 'number
    State = UCase(Data.Offset(i - 1, 2).Value) 'title
    'Descript = Data.Offset(i - 1, 3).Value
    'FMV = Format(Data.Offset(i - 1, 4).Value, "#,000")
    'FMText = Data.Offset(i - 1, 5).Value
    'Donor = Data.Offset(i - 1, 6).Value
     
    ' Send commands To Word
    With WordApp
        With .Selection
            With .Section.PageSetup '***not being applied***
                .LineNumbering.Active = False
                .Orientation = wdOrientPortrait
                .TopMargin = InchesToPoints(0.5)
                .BottomMargin = InchesToPoints(0.5)
                .LeftMargin = InchesToPoints(0.5)
                .RightMargin = InchesToPoints(0.5)
                .Gutter = InchesToPoints(0)
                .HeaderDistance = InchesToPoints(0.5)
                .FooterDistance = InchesToPoints(0.5)
                .PageWidth = InchesToPoints(8.5)
                .PageHeight = InchesToPoints(11)
                .FirstPageTray = wdPrinterDefaultBin
                .OtherPagesTray = wdPrinterDefaultBin
                .SectionStart = wdSectionNewPage
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .VerticalAlignment = wdAlignVerticalTop
                .SuppressEndnotes = False
                .MirrorMargins = False
                .TwoPagesOnOne = False
                .BookFoldPrinting = False
                .BookFoldRevPrinting = False
                .BookFoldPrintingSheets = 1
                .GutterPos = wdGutterPosLeft
            End With
            
            'Name, address, contact
            .ParagraphFormat.Alignment = 2
            .Font.Name = "Times New Roman"
            .Font.Size = 14
            .Font.Bold = True
            .TypeText Text:="Name" & Chr(11)
            .Font.Size = 12
            .Font.Bold = False
            .TypeText Text:="Address" & Chr(11)
            .TypeText Text:="City, State Zip" & Chr(11)
            .TypeText Text:="Phone" & Chr(11)
            .TypeText Text:="Email: " '***hyperlink still in wrong font***
            .Hyperlinks.Add Anchor:=.Range, _
            Address:="mailto:joe@shmoe[URL="http://cnn.com"].com[/URL]", _
            ScreenTip:="joe@shmoe.com", _
            TextToDisplay:="jo[EMAIL="e@shmoe.com"]e@shmoe.com[/EMAIL]"
            
            'horizontal line
            .TypeParagraph
            With .ParagraphFormat
                .Alignment = 0
                With .Borders(wdBorderTop)
                    .LineStyle = wdLineStyleThinThickSmallGap
                    .LineWidth = wdLineWidth300pt
                    .Color = wdColorAutomatic
                End With
                With .Borders
                    .DistanceFromTop = 1
                    .DistanceFromLeft = 4
                    .DistanceFromBottom = 1
                    .DistanceFromRight = 4
                    .Shadow = False
                End With
            End With
            
            'date
            .TypeText Text:=Chr(11) & Format(Date, "mmmm d, yyyy") & Chr(11)
            
            'title
            .TypeParagraph
            .ParagraphFormat.Alignment = 1
            .Font.Size = 18
            .Font.Bold = True
            .Font.Underline = True
            .TypeText Text:="Document Title"
            .Font.Size = 12
            .Font.Bold = False
            .Font.Underline = False
            
            'body
            .TypeParagraph
            .ParagraphFormat.Alignment = 0
            .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
            .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
            .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
            
            'data
            .TypeParagraph
            .TypeText Text:=APPLICANT & vTab & "AAA"
            '.TypeText Text:=AAA
            
            .TypeParagraph 'for each location
            .TypeText Text:="blahblah...more text."
            
            .TypeParagraph
            .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
            
            .TypeParagraph 'for each location
            .TypeText Text:="blahblah...more text."
            
        End With
    End With
 
' Save the Word file And Close it -- will need to move Word creation/save to within For/i loop
With WordApp
    .ActiveDocument.SaveAs Filename:=SaveAsName
    .ActiveWindow.Close
    ' Kill the Object
    .Quit
End With
 
Set WordApp = Nothing
Next i
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[kreitzig]

Well, no one posted...I suppose it's not a huge deal. I got some guidance from someone on another forum. If anyone is interested, please post, and I'll respond with what was done to resolve the issues.