Word VBA代码无法实现科学名称句首大写格式转换求助

问题说明 #

现有Word VBA代码可从Excel工作表（Sheet1，A列）提取科学名称，在Word文档中查找替换并设置字体格式（加粗、斜体、RGB(200,187,0)颜色、Times New Roman字体），但存在以下问题：

• 尝试用wdTitleSentence将科学名称转为属名首字母大写、种名小写的标准格式（如hyla cinerea/Hyla Cinerea转为Hyla cinerea）时无效，其他大小写参数（如wdUpperCase）可正常生效
• 希望直接继承Excel文件中的正确格式，或实现自定义大小写转换逻辑

修改后的完整代码 #

Sub format_scientific_names()
    Dim xlapp As Object
    Dim xlbook As Object
    Dim xlsheet As Object
    Dim myarray As Variant
    Dim FD As FileDialog
    Dim strSource As String
    Dim i As Long, lognum As Long
    Dim bstartApp As Boolean ' 补充声明变量
    Dim rng As Range ' 补充声明Range变量
    Dim sciName As String, genus As String, species As String
    Dim nameParts() As String
    
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .Title = "Select the workbook that contains the terms to be formatted"
        .Filters.Clear
        .Filters.Add "Excel Workbooks", "*.xlsx"
        .AllowMultiSelect = False
        If .Show = -1 Then
            strSource = .SelectedItems(1)
        Else
            MsgBox "You did not select the workbook that contains the data"
            Exit Sub
        End If
    End With
    
    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")
    If Err Then
        bstartApp = True
        Set xlapp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    
    Set xlbook = xlapp.Workbooks.Open(strSource)
    Set xlsheet = xlbook.Worksheets(1)
    myarray = xlsheet.Range("A1").CurrentRegion.Value
    If bstartApp = True Then
        xlapp.Quit
    End If
    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing
    
    For i = LBound(myarray) To UBound(myarray)
        Selection.HomeKey wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            Do While .Execute(FindText:=myarray(i, 1), Forward:=True, _
                MatchWildcards:=True, Wrap:=wdFindStop, MatchCase:=False) = True
                Set rng = Selection.Range
                Selection.Collapse wdCollapseEnd
                
                ' 处理科学名称大小写：属名首字母大写，种名全小写
                sciName = rng.Text
                nameParts = Split(Trim(sciName), " ")
                If UBound(nameParts) >= 1 Then ' 确保是双词格式
                    genus = UCase(Left(nameParts(0), 1)) & LCase(Mid(nameParts(0), 2))
                    species = LCase(nameParts(1))
                    rng.Text = genus & " " & species
                Else
                    ' 单词情况直接首字母大写
                    rng.Text = UCase(Left(sciName, 1)) & LCase(Mid(sciName, 2))
                End If
                
                ' 设置字体格式
                rng.Font.Italic = True
                rng.Font.Bold = True
                rng.Font.Color = RGB(200, 187, 0)
                rng.Font.Name = "Times New Roman"
            Loop
        End With
    Next i
End Sub

关键修改说明 #

• 补充变量声明：添加bstartApp和rng的变量声明，避免VBA编译错误
• 自定义大小写转换逻辑：
  • 将找到的科学名称按空格拆分为属名和种名
  • 属名：首字母大写，其余小写；种名：全部小写
  • 单词情况直接首字母大写，兼容特殊情况
• 格式设置顺序调整：先修改文本内容（大小写），再设置字体格式，确保格式应用到修改后的文本
• 继承Excel格式的替代方案：如果Excel中已经存储了正确格式的科学名称（如Hyla cinerea），可以直接用myarray(i,1)替换rng.Text，无需自定义转换，代码中可替换为：

  rng.Text = myarray(i, 1)
  

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