VBA - 根据 Excel 单元格值更改 MS Word 字体样式

Question

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

Answer 1

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.

Answer 2

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