邮件合并时，指定合并域字体

clotus

请教：

word 邮件合并时，如何将合并域设置为excel中指定的字体？
Excel：

姓名	字体
张三	楷体
李四	宋体
王五	隶书
赵六	仿宋

word：
《姓名》 先生

邮件合并时，不同的姓名，如何设置为excel中指定的不同字体？
姓名为张三时，“姓名”处，设置为：楷体；
姓名为李四时，“姓名”处，设置为：宋体  ……

谢谢。

zjg121

[Python] 纯文本查看 复制代码

Sub SetFontBetweenMarkersToSongTiAndRemoveMarkers()  
    Dim doc As Document  
    Dim startMarker As String  
    Dim endMarker As String  
    Dim startRange As Range  
    Dim endRange As Range  
    Dim contentRange As Range  
    Dim foundStart As Boolean  
    Dim foundEnd As Boolean  
      
    ' 设置开始和结束标记  
    startMarker = "宋体开始"  
    endMarker = "宋体结束"  
      
    ' 获取当前活动的文档  
    Set doc = ActiveDocument  
      
    ' 设置初始内容范围为整个文档内容  
    Set contentRange = doc.Content  
      
    ' 循环遍历文档内容  
    Do While Not contentRange.End = doc.Content.End  
        ' 查找开始标记  
        foundStart = False  
        With contentRange.Find  
            .ClearFormatting  
            .Text = startMarker  
            .Execute  
            If .Found Then  
                foundStart = True  
                Set startRange = contentRange.Duplicate  
                startRange.Collapse wdCollapseEnd  
                startRange.MoveStart wdCharacter, Len(startMarker)  
                  
                ' 查找结束标记  
                foundEnd = False  
                With contentRange.Find  
                    .ClearFormatting  
                    .Text = endMarker  
                    .Execute  
                    If .Found Then  
                        foundEnd = True  
                        Set endRange = contentRange.Duplicate  
                        endRange.Collapse wdCollapseStart  
                        endRange.MoveEnd wdCharacter, -Len(endMarker)  
                          
                        ' 设置开始和结束范围之间的文本为宋体  
                        startRange.End = endRange.Start  
                        startRange.Font.Name = "宋体"  
                          
                        ' 删除开始和结束标记  
                        startRange.Collapse wdCollapseStart  
                        startRange.Delete  
                        endRange.Collapse wdCollapseEnd  
                        endRange.Delete  
                          
                        ' 更新内容范围以继续搜索  
                        contentRange.Start = endRange.Start  
                    Else  
                        ' 如果没有找到结束标记，则删除开始标记并退出循环  
                        startRange.Collapse wdCollapseStart  
                        startRange.Delete  
                        Exit Do  
                    End If  
                End With  
            End If  
        End With  
          
        ' 如果当前内容范围已到达文档末尾，则退出循环  
        If contentRange.End = doc.Content.End Then  
            Exit Do  
        End If  
          
        ' 移动内容范围的起始点到当前位置的下一个字符，继续搜索  
        contentRange.Start = contentRange.End  
        contentRange.Collapse wdCollapseStart  
    Loop  
End Sub

jys159

你这个有点难度，应该得用宏，

zjg121

直接对设置域的字体，如下面图片中的姓名设为仿宋，居住地设为黑体。预览后就是所设置的样子。

dlxg

zjg121 发表于 2024-4-23 09:38
直接对设置域的字体，如下面图片中的姓名设为仿宋，居住地设为黑体。预览后就是所设置的样子。

你是没理解楼主的意思，他是同一个位置，显示不同的内容，对应不同的字体。。不是你这个。

zjg121

这也好办，三个步骤即可：1excel里的姓名和字体组合一下如：张三 宋体 变成一个    宋体开始张三宋体结束。2插入时不要插入姓名，插入姓名组合字体的那一列。3完成后，再用vba替换一下。

clotus

zjg121 发表于 2024-4-22 20:01
[mw_shl_code=python,true]Sub SetFontBetweenMarkersToSongTiAndRemoveMarkers()  
    Dim doc As Docum ...

感谢相助。我是
1、在word最后一行，把字体作为合并域，写进去。
2、生成邮件文件后，粘贴进代码，
3、循环：定位关键字，读取字体名称，修改为选定的字体后，把字体标识改为空格。