将字符输出到Word文档，每个字符具有不同的格式

Question

ChatGPT 和我正在编写一个程序来操作 Word 文档，该文档将包含用新的乐谱系统编写的歌曲和歌词，如下所述：https://www.youtube.com/watch?v=dSkx76Kjfmw每个字母（音符）都会使用 Word 的字体缩放功能进行更改，并指示音符播放的时间：

我们目前正在开发的模块会将音符与歌词音节垂直对齐，并以增加或减少的间距输出它们，如上图所示。 （这将是唯一一个自动检测音节的乐谱程序，无需用户手动连接多音节单词）。

注释采用 Courier New 字体，因此字符宽度均相同（缩放前）。每个字符，包括注释之间的空格，都有独特的字体格式（字体名称、大小、粗体和缩放比例）

我和 ChatGPT 都无法正确格式化。我们的代码读取每个字符并将其与字体属性一起存储。确定需要多少个空格后，必须使用与之前相同的属性写回字符。空间缩小至 30%，以便进行更精细的间隙调整。

这是我们迄今为止想出的代码，用于在删除现有行后输出一行注释，但它不起作用。它将字符写入下一行而不是当前行的开头，并且不会将唯一的字体属性应用于每个字符。

Sub InsertNotesIntoDocument(notesLine As NotesLineClass)
    Dim lineNumber As Integer
    Dim i As Integer
    Dim noteClass As noteClass
    Dim noteSubClass As noteSubClass
    
    ' Determine the line number to insert the notes into
    lineNumber = notesLine.lineNumber

    ' Set the range to the start of the specified line within the selection
    Dim rng As Range
    Set rng = ActiveDocument.Paragraphs(lineNumber).Range
    rng.End = rng.End - 1 ' Exclude paragraph mark at the end of the line

    ' Clear the existing content of the line (except the paragraph mark)
    rng.Text = vbNullString
    
    ' Iterate through each NoteClass object in the collection
    For Each noteClass In notesLine.Notes
        ' Set font properties for the entire note
        With rng.Font
            .Name = noteClass.FontName
            .Size = noteClass.FontSize
        End With
        
        ' Iterate through each SubNoteClass object in the SubNotes collection
        For Each noteSubClass In noteClass.SubNotes
            ' Insert a new range for each character insertion
            Dim charRng As Range
            Set charRng = rng.Duplicate
            
            ' Apply character-specific properties
            With charRng.Font
                .Bold = noteSubClass.Bold
                .Scaling = noteSubClass.Scaling
            End With
            
            ' Insert the character into the document
            charRng.Text = noteSubClass.NoteChar
            
            ' Move the original range to the end of the inserted character
            rng.Collapse wdCollapseEnd
        Next noteSubClass
        
        ' Insert spaces scaled to 30% between notes if needed
        For i = 1 To noteClass.PaddingBytes
            rng.Text = " " ' Insert a space directly using the main range
            rng.Collapse wdCollapseEnd ' Move past the space
        Next i
    Next noteClass
End Sub

Answer 1

我解决了。 ChatGPT 试图在错误的位置和错误的阶段设置字体属性。

Sub InsertNotesIntoDocument(notesLine As NotesLineClass)
    Dim lineNumber As Integer
    Dim FontSize As Integer
    Dim i As Integer
    Dim noteClass As noteClass
    Dim noteSubClass As noteSubClass
    Dim rng, charRng As Range
   
    lineNumber = notesLine.lineNumber  ' Line number to insert the notes into
    FontSize = notesLine.FontSize  ' Font size

    ' Set the range to the start of the specified line within the selection
    Set rng = ActiveDocument.Paragraphs(lineNumber).Range
    rng.End = rng.End - 1 ' Exclude paragraph mark at the end of the line

    ' Clear the existing content of the line (except the paragraph mark)
    rng.Text = vbNullString
    
    ' Iterate through each NoteClass object in the collection
    For Each noteClass In notesLine.Notes
        
        ' Iterate through each SubNoteClass object in the SubNotes collection
        For Each noteSubClass In noteClass.SubNotes
            ' Insert the character into the document
            rng.Text = noteSubClass.NoteChar
            With rng.Font           ' Set font attributes
                .Name = "Courier New"
                .Size = FontSize
                .Bold = noteSubClass.Bold
                .Scaling = noteSubClass.Scaling
            End With
            
            ' Move the original range to the end of the inserted character
            rng.Collapse wdCollapseEnd
       Next noteSubClass
        
        ' Insert spaces scaled to 30% between notes if needed
        For i = 1 To noteClass.PaddingBytes
            rng.Text = " " ' Insert a space
            rng.Font.Scaling = 30
            rng.Collapse wdCollapseEnd ' Move past the space
        Next i
    Next noteClass
End Sub