VBA中Application.Dialogs(xlDialogActiveCellFont)的Arg9参数报错求助

我正在开发一款工具，通过Userform让用户设置未来生成的里程碑文本框默认字体。用户可查看当前字体设置，点击按钮调用Excel自带的Application.Dialogs(xlDialogActiveCellFont)对话框选择字体、字号等样式。

但在使用该对话框的Arg9（下划线）参数时遇到问题：微软未说明该参数的变量类型，尝试多种输入均无效。由于ActiveCell.Font.Underline为Long类型，我编写了GetData_MSMFontUnderline函数，将下划线样式名称转换为对应常量（如"None"对应xlUnderlineStyleNone即-4142），传入Long类型值后仍触发报错：

Run-time error '1004':
Unable to get the Show property of the Dialog Class

附上相关代码：

Option Explicit

Private Sub CommandButton1_Click()

    With Application.Dialogs(xlDialogActiveCellFont)
        If .Show(Arg1:=Me.Txt_MSMFontName.Value, Arg3:=Int(Me.Txt_MSMFontSize.Value), Arg9:=GetData_MSMFontUnderline(Me.Txt_MSMFontUnderline, FALSE)) = True Then
            Me.Txt_MSMFontName.Value = .Application.ActiveCell.Font.Name
            Me.Txt_MSMFontSize = .Application.ActiveCell.Font.Size
            Me.ChkBox_MSMFontBold.Value = .Application.ActiveCell.Font.Bold
            Me.ChkBox_MSMFontItalic.Value = .Application.ActiveCell.Font.Italic
            Me.Txt_MSMFontUnderline = GetData_MSMFontUnderline(.Application.ActiveCell.Font.Underline, True)
        End If
    End With

End Sub

Private Function GetData_MSMFontUnderline(ValIn As Variant, Optional Bln_ValIsNumber As Boolean) As Variant

    Dim arr(1 To 2, 1 To 5) As Variant
        
        arr(1, 1) = xlUnderlineStyleNone
        arr(2, 1) = "None"
        arr(1, 2) = xlUnderlineStyleDouble
        arr(2, 2) = "Double"
        arr(1, 3) = xlUnderlineStyleSingle
        arr(2, 3) = "Single"
        arr(1, 4) = xlUnderlineStyleSingleAccounting
        arr(2, 4) = "Single Accounting"
        arr(1, 5) = xlUnderlineStyleDoubleAccounting
        arr(2, 5) = "Double Accounting"

    Dim i As Long
    
    On Error GoTo ExitFunc
        If Bln_ValIsNumber Then
            
            For i = 1 To 5
                If arr(1, i) = ValIn Then
                    GetData_MSMFontUnderline = arr(2, i)
                    Exit For
                End If
            Next i

        Else
        
            For i = 1 To 5
                If arr(2, i) = ValIn Then
                    GetData_MSMFontUnderline = arr(1, i)
                    Exit For
                End If
            Next i
            
        End If
        
ExitFunc:

End Function

问题排查与修复方案 #

1. 参数传递顺序错误：xlDialogActiveCellFont的参数必须按顺序传递，不能跳过中间参数仅指定部分命名参数。未指定的中间参数会被视为无效值，直接导致对话框调用失败。
2. 下划线参数类型不匹配：虽然ActiveCell.Font.Underline是Long类型，但xlDialogActiveCellFont的Arg9参数实际接受0-4的整数（对应不同下划线样式），而非VBA内置的xlUnderlineStyle常量值。
3. 函数返回值不兼容：原GetData_MSMFontUnderline返回的是VBA常量（如-4142），不符合对话框参数要求，需转换为0-4的对应数值。

修改后的代码 #

Option Explicit

Private Sub CommandButton1_Click()
    Dim underlineVal As Integer
    
    ' 将文本样式转换为对话框接受的数值
    Select Case Me.Txt_MSMFontUnderline.Value
        Case "None"
            underlineVal = 0
        Case "Single"
            underlineVal = 1
        Case "Double"
            underlineVal = 2
        Case "Single Accounting"
            underlineVal = 3
        Case "Double Accounting"
            underlineVal = 4
        Case Else
            underlineVal = 0
    End Select
    
    ' 按顺序传递参数，未设置的用Empty占位
    If Application.Dialogs(xlDialogActiveCellFont).Show( _
        Arg1:=Me.Txt_MSMFontName.Value, _
        Arg2:=Empty, _
        Arg3:=Int(Me.Txt_MSMFontSize.Value), _
        Arg4:=Me.ChkBox_MSMFontBold.Value, _
        Arg5:=Me.ChkBox_MSMFontItalic.Value, _
        Arg6:=Empty, _
        Arg7:=Empty, _
        Arg8:=Empty, _
        Arg9:=underlineVal, _
        Arg10:=Empty, _
        Arg11:=Empty, _
        Arg12:=Empty, _
        Arg13:=Empty) = True Then
        
        ' 更新用户控件显示值
        Me.Txt_MSMFontName.Value = ActiveCell.Font.Name
        Me.Txt_MSMFontSize.Value = ActiveCell.Font.Size
        Me.ChkBox_MSMFontBold.Value = ActiveCell.Font.Bold
        Me.ChkBox_MSMFontItalic.Value = ActiveCell.Font.Italic
        
        ' 将返回的下划线常量转换为文本
        Select Case ActiveCell.Font.Underline
            Case xlUnderlineStyleNone
                Me.Txt_MSMFontUnderline.Value = "None"
            Case xlUnderlineStyleSingle
                Me.Txt_MSMFontUnderline.Value = "Single"
            Case xlUnderlineStyleDouble
                Me.Txt_MSMFontUnderline.Value = "Double"
            Case xlUnderlineStyleSingleAccounting
                Me.Txt_MSMFontUnderline.Value = "Single Accounting"
            Case xlUnderlineStyleDoubleAccounting
                Me.Txt_MSMFontUnderline.Value = "Double Accounting"
            Case Else
                Me.Txt_MSMFontUnderline.Value = "None"
        End Select
    End If
End Sub

关键说明 #

• 调用Show方法时必须严格按参数顺序传递，跳过的参数用Empty占位，不能仅指定部分命名参数。
• Arg9参数接受0-4的整数，对应关系为：0=无下划线，1=单下划线，2=双下划线，3=会计单下划线，4=会计双下划线。
• 直接使用ActiveCell访问字体属性即可，无需通过.Application.ActiveCell。

内容的提问来源于stack exchange，提问作者MDuncanson