Изменение эффекта цвета шрифта в shaperange работает только с первыми тремя (из четырех или пяти) фигурами.Как исправить? - PullRequest
Новая
       8

Изменение эффекта цвета шрифта в shaperange работает только с первыми тремя (из четырех или пяти) фигурами.Как исправить?

0 голосов
/ 01 мая 2019

У меня есть файл excel с 2500 китайскими словами, который я хотел бы превратить в презентацию PPT с VBA.Поскольку китайский язык является тональным, я хочу, чтобы символы меняли цвет в зависимости от его тона (от 1 до 5).У меня нет проблем с добавлением фигур в презентацию и их форматированием.У меня есть всего пять анимаций, которые мне нужно добавить, и четыре из них работают отлично (постепенно, постепенно, постепенно, постепенно).Единственная проблема - изменение цвета шрифта для анимации китайских иероглифов.

Я создал диапазон форм со всеми возможными именами форм ("HZ1", "HZ2", "HZ3", "HZ4", "HZ5") и переделан так, чтобы сохранить правильное числоформ.Оператор if проверит соответствующую ячейку в моем файле Excel, чтобы проверить, какой тон использовать, и на этом основании установить color2.Весь процесс работает гладко, если форма содержит 3 или менее фигур, и он правильно установит цвет анимации.Однако, если диапазон формы содержит 4 или 5 фигур, он будет работать только для первых трех фигур, в то время как формы 4 и 5 будут добавлять анимацию, но не смогут установить правильный цвет (вместо этого он станет оранжевым).Я понятия не имею, что вызывает эту ошибку, и был бы признателен за любую помощь, которую я могу получить. 

    Sub AnimationLoop()


Dim finalrow As Integer 'final row
Dim pyArray As Variant
Dim ptArray As Variant
Dim hzArray As Variant
Dim i As Integer 'row counter
Dim j As Integer 'Used in if loop
Dim k As Integer 'Used in if loop
Dim l As Integer 'counting number of shapes
Dim m As Integer 'Makes color change to corresponding shape
Dim n As Integer 'starting point
Dim w As Long 'width
Dim start As Long
Dim mid As Long

Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShape As PowerPoint.Shape
Dim oShp As PowerPoint.Shape 'Audio File
Dim sEff As PowerPoint.Effect
Dim sEff1 As PowerPoint.Effect
Dim shp As PowerPoint.Shape
Dim shpRng1 As PowerPoint.ShapeRange
Dim shpRng2 As PowerPoint.ShapeRange
Dim shpRng3 As PowerPoint.ShapeRange




'This is where Shapes are added (omitted for github)
 'Animations follow


l = (Cells(i, 18) - 1)
pyArray = Array("PY1", "PY2", "PY3", "PY4", "PY5")
ReDim Preserve pyArray(l)
ptArray = Array("PT1", "PT2", "PT3", "PT4", "PT5")
ReDim Preserve ptArray(l)
hzArray = Array("HZ1", "HZ2", "HZ3", "HZ4", "HZ5")
ReDim Preserve hzArray(l)

Set shpRng1 = mySlide.Shapes.Range(pyArray) 'Pinyin Animation
For Each shp In shpRng1
    Set sEff = mySlide.TimeLine.MainSequence.AddEffect(Shape:=shp, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerWithPrevious) 'Fade in
    With sEff
        .Timing.Duration = 0.5
        .Timing.TriggerDelayTime = 3
    End With
    Set sEff = mySlide.TimeLine.MainSequence.AddEffect(Shape:=shp, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerWithPrevious) 'Fade out
    With sEff
        .Exit = msoTrue
        .Timing.Duration = 0.25
        .Timing.TriggerDelayTime = 5.75
    End With
Next shp

Set shpRng2 = mySlide.Shapes.Range(ptArray) 'Tones Animation
For Each shp In shpRng2
    Set sEff = mySlide.TimeLine.MainSequence.AddEffect(Shape:=shp, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerWithPrevious) 'Fade in
    With sEff
        .Timing.Duration = 0.5
        .Timing.TriggerDelayTime = 6
    End With
Next shp


'THIS IS WHERE THE PROBLEM IS
'THIS IS WHERE THE PROBLEM IS

Set shpRng3 = mySlide.Shapes.Range(hzArray) 'Hanzi Animation
m = 1
For Each shp In shpRng3
    Debug.Print "m:"; m
    Set sEff = mySlide.TimeLine.MainSequence.AddEffect(Shape:=shp, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerWithPrevious) 'Fade in
    With sEff
        .Timing.Duration = 0.5
        .Timing.TriggerDelayTime = 1
    End With

    Set sEff1 = mySlide.TimeLine.MainSequence.AddEffect(Shape:=shp, effectid:=msoAnimEffectChangeFontColor, trigger:=msoAnimTriggerWithPrevious) 'Change color font
    With sEff1
        If Cells(i, 10 + m) = "1" Then
            .EffectParameters.Color2.RGB = RGB(255, 0, 0)
        ElseIf Cells(i, 10 + m) = "2" Then
            .EffectParameters.Color2.RGB = RGB(112, 173, 71)
        ElseIf Cells(i, 10 + m) = "3" Then
            .EffectParameters.Color2.RGB = RGB(16, 123, 240)
        ElseIf Cells(i, 10 + m) = "4" Then
            .EffectParameters.Color2.RGB = RGB(141, 66, 198)
        ElseIf Cells(i, 10 + m) = "5" Then
            .EffectParameters.Color2.RGB = RGB(142, 142, 142)
        Else
            .EffectParameters.Color2.RGB = RGB(255, 255, 255)
        End If
        .Timing.Duration = 0.5
        .Timing.TriggerDelayTime = 6
    End With
    m = m + 1
Next shp
...