操作 TextRange 时 Mac 与 Windows 与 Lines/Paragraphs 的差异
Differences Mac vs Windows with Lines/Paragraphs when manipulating TextRange
更新
I found out that the vbCrLf is a vbLf on mac -- and https://whosebug.com/users/1188513/mathieu-guindon came to the same conclusion parallel. Now I also found out that in Mac the TextRange is interpreted as LINES instead of PARAGRAPHS.
为了创建议程然后删除前两段,我需要以下代码:
With ActivePresentation.SectionProperties
MsgBox "We gather now the Section headers"
For iSectIndex = 1 To .Count
If ActivePresentation.SectionProperties.Name(iSectIndex) <> "" Then
#If Mac Then
sSectionCollector = sSectionCollector & vbLf & ActivePresentation.SectionProperties.Name(iSectIndex)
#Else
sSectionCollector = sSectionCollector & vbCrLf & ActivePresentation.SectionProperties.Name(iSectIndex)
#End If
End If
Next iSectIndex
End With
sAgendaTextblock.TextFrame2.TextRange.Text = sSectionCollector
#If Mac Then
MsgBox "starting to delete"
MsgBox "line 1: " & sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1).Lines(1).Text
sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1).Lines(1, 2).Delete
#Else
MsgBox "starting to delete"
MsgBox "paragraph 1: " & sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1).Text
sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1, 2).Delete
#End If
旧代码/不再相关:
抱歉,这肯定不漂亮 - 我是 VBA 初学者。此代码在 windows 上运行完美,但在 Mac 上抛出 6/Overflow。我知道我可以用 #IF Mac
重新编程 - 但首先我需要了解为什么它会抛出该错误 - 当我尝试将它读入 sSectionCollector 字符串时,它似乎是第 280 行可能 SectionProperties.Name
更新
THE CODE IS RUNNING NOW AS AN ADDIN WITHOUT ERRORS BUT IT PRODUCES DIFFERENT RESULT
Windows
Under Windows ok
Under Mac it somehow doubles the lines
Unfortunately I can not see/stepinto/debug the code in a Addin in VBAEditor :-(
Sub CreateAgendaWithSegments()
'TODO DOCU
'TODO Implement Button
Dim oSl As Slide
Dim oPl As Presentation
Dim sAgendaCnt As Long
Dim sAgendaTextblock As Shape
Dim iSectIndex As Single
Dim sSectionCollector As String
Dim NewAgenda As Slide
Dim AgendaLayout As CustomLayout
'TODO reinstall ErrorHandler
10 On Error GoTo ErrorHandler
20 If ActivePresentation.SectionProperties.Count < 2 Then
30 MsgBox "You seem to have not segmented/sectioned your presentation - therefore we can not create an automated agenda slide for you -- sorry." & vbCrLf _
& "Consider using the SEGMENT tools first.", vbOKOnly Or vbExclamation, "No Segments"
40 GoTo Ende
50 End If
'Collect Section Titles
'Search for Agenda Slide
60 Set oPl = ActivePresentation
70 For Each oSl In oPl.Slides
80 If oSl.CustomLayout.Name = "AGENDA" Then
AgendaContent:
90 sAgendaCnt = sAgendaCnt + 1
100 sAgendaIndex = oSl.SlideIndex
110 oSl.Select
120 Call ExcelWork_2020.Delay(0.5)
'Do the magic
'First Reset
130 DoEvents
140 Application.CommandBars.ExecuteMso ("SlideReset")
150 DoEvents
'find the Textblock
160 oSl.Shapes(2).TextFrame.TextRange.Text = "Agenda"
170 Set sAgendaTextblock = oSl.Shapes(1)
180 With sAgendaTextblock.TextFrame2
190 If .HasText Then
200 Debug.Print sAgendaTextblock.TextFrame2.TextRange.Text
210 Select Case MsgBox("Your agenda slide has already text. Are you sure you want to overwrite this with the new headlines from the Segmentation?", vbOKCancel Or vbExclamation, "Agenda has text")
Case vbCancel
220 GoTo Ende
230 Case vbOK
'Continue
240 End Select
250 End If 'Even if there is no text, we will write now.
'Call SectionWriter
260 With ActivePresentation.SectionProperties
270 For iSectIndex = 1 To .Count
280 sSectionCollector = sSectionCollector & vbCrLf & ActivePresentation.SectionProperties.Name(iSectIndex)
290 Next iSectIndex
300 End With
310 sAgendaTextblock.TextFrame2.TextRange.Text = sSectionCollector
320 sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1, 2).Delete
330 GoTo Ende
'End If
340 End With
350 End If
360 Next oSl
' No Agenda found - we create one
370 Set AgendaLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(6)
380 Set NewAgenda = ActivePresentation.Slides.AddSlide(2, AgendaLayout)
390 Set oSl = NewAgenda
400 GoTo AgendaContent:
410 GoTo Ende
ErrorHandler:
420 MsgBox "Something went wrong -- maybe you did not select the right object for this task? If you can't find the problem, send a mail to nik@xex.one with a short description of what you tried to achieve - we will get back to you as soon as possible", vbOKOnly Or vbExclamation, "Error"
Ende:
End Sub
问题在这里:& vbCrLf &
这是 Windows 上的换行符(Chr$(10)
& Chr$(13)
),但是 Mac 使用 Linux 样式的行结尾,如果您的 VBA代码在两个平台上都需要运行,那么最简单的方法就是将vbCrLf
替换为vbNewLine
.
vbNewLine
将在 Windows 上 vbCrLf
,vbCr
在 Mac 上:
Platform-specific new line character; whichever is appropriate for current platform
这就是 Mac 上出现双线的原因。为 vbNewLine
更改硬编码的 Windows-特定 vbCrLf
将修复行尾,解决问题。
更新
I found out that the vbCrLf is a vbLf on mac -- and https://whosebug.com/users/1188513/mathieu-guindon came to the same conclusion parallel. Now I also found out that in Mac the TextRange is interpreted as LINES instead of PARAGRAPHS.
为了创建议程然后删除前两段,我需要以下代码:
With ActivePresentation.SectionProperties
MsgBox "We gather now the Section headers"
For iSectIndex = 1 To .Count
If ActivePresentation.SectionProperties.Name(iSectIndex) <> "" Then
#If Mac Then
sSectionCollector = sSectionCollector & vbLf & ActivePresentation.SectionProperties.Name(iSectIndex)
#Else
sSectionCollector = sSectionCollector & vbCrLf & ActivePresentation.SectionProperties.Name(iSectIndex)
#End If
End If
Next iSectIndex
End With
sAgendaTextblock.TextFrame2.TextRange.Text = sSectionCollector
#If Mac Then
MsgBox "starting to delete"
MsgBox "line 1: " & sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1).Lines(1).Text
sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1).Lines(1, 2).Delete
#Else
MsgBox "starting to delete"
MsgBox "paragraph 1: " & sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1).Text
sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1, 2).Delete
#End If
旧代码/不再相关:
抱歉,这肯定不漂亮 - 我是 VBA 初学者。此代码在 windows 上运行完美,但在 Mac 上抛出 6/Overflow。我知道我可以用 #IF Mac
重新编程 - 但首先我需要了解为什么它会抛出该错误 - 当我尝试将它读入 sSectionCollector 字符串时,它似乎是第 280 行可能 SectionProperties.Name
更新
THE CODE IS RUNNING NOW AS AN ADDIN WITHOUT ERRORS BUT IT PRODUCES DIFFERENT RESULT Windows Under Windows ok Under Mac it somehow doubles the lines Unfortunately I can not see/stepinto/debug the code in a Addin in VBAEditor :-(
Sub CreateAgendaWithSegments()
'TODO DOCU
'TODO Implement Button
Dim oSl As Slide
Dim oPl As Presentation
Dim sAgendaCnt As Long
Dim sAgendaTextblock As Shape
Dim iSectIndex As Single
Dim sSectionCollector As String
Dim NewAgenda As Slide
Dim AgendaLayout As CustomLayout
'TODO reinstall ErrorHandler
10 On Error GoTo ErrorHandler
20 If ActivePresentation.SectionProperties.Count < 2 Then
30 MsgBox "You seem to have not segmented/sectioned your presentation - therefore we can not create an automated agenda slide for you -- sorry." & vbCrLf _
& "Consider using the SEGMENT tools first.", vbOKOnly Or vbExclamation, "No Segments"
40 GoTo Ende
50 End If
'Collect Section Titles
'Search for Agenda Slide
60 Set oPl = ActivePresentation
70 For Each oSl In oPl.Slides
80 If oSl.CustomLayout.Name = "AGENDA" Then
AgendaContent:
90 sAgendaCnt = sAgendaCnt + 1
100 sAgendaIndex = oSl.SlideIndex
110 oSl.Select
120 Call ExcelWork_2020.Delay(0.5)
'Do the magic
'First Reset
130 DoEvents
140 Application.CommandBars.ExecuteMso ("SlideReset")
150 DoEvents
'find the Textblock
160 oSl.Shapes(2).TextFrame.TextRange.Text = "Agenda"
170 Set sAgendaTextblock = oSl.Shapes(1)
180 With sAgendaTextblock.TextFrame2
190 If .HasText Then
200 Debug.Print sAgendaTextblock.TextFrame2.TextRange.Text
210 Select Case MsgBox("Your agenda slide has already text. Are you sure you want to overwrite this with the new headlines from the Segmentation?", vbOKCancel Or vbExclamation, "Agenda has text")
Case vbCancel
220 GoTo Ende
230 Case vbOK
'Continue
240 End Select
250 End If 'Even if there is no text, we will write now.
'Call SectionWriter
260 With ActivePresentation.SectionProperties
270 For iSectIndex = 1 To .Count
280 sSectionCollector = sSectionCollector & vbCrLf & ActivePresentation.SectionProperties.Name(iSectIndex)
290 Next iSectIndex
300 End With
310 sAgendaTextblock.TextFrame2.TextRange.Text = sSectionCollector
320 sAgendaTextblock.TextFrame2.TextRange.Paragraphs(1, 2).Delete
330 GoTo Ende
'End If
340 End With
350 End If
360 Next oSl
' No Agenda found - we create one
370 Set AgendaLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(6)
380 Set NewAgenda = ActivePresentation.Slides.AddSlide(2, AgendaLayout)
390 Set oSl = NewAgenda
400 GoTo AgendaContent:
410 GoTo Ende
ErrorHandler:
420 MsgBox "Something went wrong -- maybe you did not select the right object for this task? If you can't find the problem, send a mail to nik@xex.one with a short description of what you tried to achieve - we will get back to you as soon as possible", vbOKOnly Or vbExclamation, "Error"
Ende:
End Sub
问题在这里:& vbCrLf &
这是 Windows 上的换行符(Chr$(10)
& Chr$(13)
),但是 Mac 使用 Linux 样式的行结尾,如果您的 VBA代码在两个平台上都需要运行,那么最简单的方法就是将vbCrLf
替换为vbNewLine
.
vbNewLine
将在 Windows 上 vbCrLf
,vbCr
在 Mac 上:
Platform-specific new line character; whichever is appropriate for current platform
这就是 Mac 上出现双线的原因。为 vbNewLine
更改硬编码的 Windows-特定 vbCrLf
将修复行尾,解决问题。