VBA - Change MS Word Font Style Based on Excel Cell Values

SingleMaltScott 0
Viewed 41

I want to automatically change a document’s font type and size based on Excel cell values. For example, if I input “Times New Roman” in cell B3 and 12 in cell B4, then the document should be formatted with these styles. However, when I run my macro, it ignores my variables and I can’t figure out why. Below is my code:

Sub FormatWholeAsDefaultFont()
    Dim mySpreadsheet As Excel.Workbook
    Dim strFont As String, strRange As String
    Dim sngFontSize As Single, sngTopMargin As Single, _
        sngBottomMargin As Single, sngLeftMargin As Single, _
        sngRightMargin As Single
    Set mySpreadsheet = _
           GetObject("C:\Files\Data\Excel\Document Timesheet.xlsm")
    
    strFont = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B2").Value
    sngFontSize = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B3").Value
    sngLeftMargin = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B5").Value
    sngRightMargin = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B6").Value
    sngTopMargin = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B7").Value
    sngBottomMargin = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B8").Value
    strRange = mySpreadsheet.Application.Workbooks("Document Timesheet.xlsm") _
            .Sheets("Document Agreement").Range("B9").Value
    'strFont = CStr(strFont)
    Selection.WholeStory
    With ActiveDocument.Styles(wdStyleNormal).Font
        .Name = strFont
        .Size = sngFontSize
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 11
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
End Sub
fonts vba ms-word excel
2 Answers

You have a lot of unnecessary code in your routine. Below is a simplified version.

Sub FormatWholeAsDefaultFont()
    Dim mySpreadsheet As Excel.Workbook
    Dim strFont As String, strRange As String
    Dim sngFontSize As Single, sngTopMargin As Single, _
        sngBottomMargin As Single, sngLeftMargin As Single, _
        sngRightMargin As Single
    Set mySpreadsheet = _
        GetObject("C:\Files\Data\Excel\Document Timesheet.xlsm")
    
    With mySpreadsheet.Sheets("Document Agreement")
        strFont = .Range("B2").Value
        sngFontSize = .Range("B3").Value
        sngLeftMargin = .Range("B5").Value
        sngRightMargin = .Range("B6").Value
        sngTopMargin = .Range("B7").Value
        sngBottomMargin = .Range("B8").Value
        strRange = .Range("B9").Value
    End With
    
    With ActiveDocument.Styles(wdStyleNormal).Font
        .Name = strFont
        .Size = sngFontSize
    End With
End Sub

Please note:

Since Word 2007 it has been necessary to set the document's default font in the Set Defaults tab of the Manage Styles dialog, accessed from a button at the bottom of the Styles pane or by typing Dialogs(wdDialogStyleManagement).Show into the Immediate Window. It is vital for the correct working of Table Styles that the Normal style match these document defaults.

However, it is not possible to set the document defaults using VBA.

Timothy Rylatt0 
Sub FormatWholeAsDefaultFont()
    Dim mySpreadsheet As Excel.Workbook
    Dim strFont As String, strRange As String
    Dim sngFontSize As Single, sngTopMargin As Single, _
        sngBottomMargin As Single, sngLeftMargin As Single, _
        sngRightMargin As Single
    Set mySpreadsheet = _
        GetObject("C:\Files\Data\Excel\Document Timesheet.xlsm")
    
    With mySpreadsheet.Sheets("Document Agreement")
        strFont = .Range("B2").Value
        sngFontSize = .Range("B3").Value
        sngLeftMargin = .Range("B5").Value
        sngRightMargin = .Range("B6").Value
        sngTopMargin = .Range("B7").Value
        sngBottomMargin = .Range("B8").Value
        strRange = .Range("B9").Value
    End With
    
    Selection.WholeStory
    Selection.Font.Name = strFont
    Selection.Font.Size = sngFontSize
    
    With ActiveDocument.Styles(wdStyleNormal).Font
        .Name = strFont
        .Size = sngFontSize
    End With
End Sub
SingleMaltScott0
Related