Question

好吧，对于PHP脚本，我需要将所有非图像对象从.pptx文件转换为图像（不包括文本）。因为我有很多.pptx文件，我认为我也可以使用VBA。

出于某种原因，我的Else If表现得很奇怪。

Sub nieuwemacro()
    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes

            ' MsgBox (oSh.Type)
            ' modify the following depending on what you want to
            ' convert
            If oSh.Type = 1 Then
                ConvertShapeToPic oSh
            Else
            End If
        Next
    Next
End Sub

Sub ConvertShapeToPic(ByRef oSh As Shape)
    Dim oNewSh As Shape
    Dim oSl As Slide

    oSh.Fill.ForeColor.RGB = RGB(0, 0, 0)

    Set oSl = oSh.Parent
    oSh.Copy
    Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)

    With oNewSh
        .Left = oSh.Left
        .Top = oSh.Top
        Do
            .ZOrder (msoSendBackward)
        Loop Until .ZOrderPosition = .ZOrderPosition
     End With

    oSh.Delete
End Sub

oSh.Fill.ForeColor.RGB = RGB（0,0,0）部分就在那里看看会发生什么。这就是结果：

好吧..所以一切都正常转换，除了粉红色的大球。所以我想我会尝试其他一些其他的ifs。我的新Else If声明：

If oSh.Type = 1 Then
    ConvertShapeToPic oSh
ElseIf oSh.Type = 14 Then
    ConvertShapeToPic oSh
Else
End If

导致：

请注意代码现在如何转换顶部的绿色栏？当我添加或删除IfElse部件时，它会这样做... 我不知道为什么会这样做，有人能告诉我我做错了什么吗？

Answer 1

试试这个

//
//  ViewController.h


#import <UIKit/UIKit.h>
#import "Accounts/Accounts.h"
@import GameKit;


@interface ViewController : UIViewController {

    //Here should be declared everything for the Main.storyboard but it's unnecessarily long and it works, so no need to post it here.

    NSMutableArray *tasks;
    NSArray *shuffledTasks;
    NSMutableArray *zamichano;

}




- (void)TimerCount;
- (void)shuffle;

- (IBAction)random:(id)sender;
//Again, here would be things for the storyboard.



@end

您可能还需要考虑以下重构：

Option Explicit

Sub nieuwemacro()
    Dim oSl As Slide
    Dim oSh As Shape
    Dim oShs() As Shape
    Dim nShps As Long, iShp As Long

    For Each oSl In ActivePresentation.Slides

        ReDim oShs(1 To oSl.Shapes.Count) As Shape
        For Each oSh In oSl.Shapes
            ' MsgBox (oSh.Type)
            ' modify the following depending on what you want to
            ' convert
            If oSh.Type = 1 Then
                nShps = nShps + 1
                Set oShs(nShps) = oSh
            End If
        Next
        If nShps > 0 Then
            For iShp = 1 To nShps
                ConvertShapeToPic oShs(iShp)
            Next iShp
        End If
    Next
End Sub

Sub ConvertShapeToPic(ByRef oSh As Shape)
    Dim oNewSh As Shape
    Dim oSl As Slide

    oSh.Fill.ForeColor.RGB = RGB(0, 0, 0)

    Set oSl = oSh.Parent
    oSh.Copy
    Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)

    With oNewSh
        .Left = oSh.Left
        .Top = oSh.Top
        Do
            .ZOrder (msoSendBackward)
        Loop Until .ZOrderPosition = .ZOrderPosition
     End With

    oSh.Delete
End Sub

最后，您可能希望将“main”sub缩短两行，更像follwos

Option Explicit

Sub nieuwemacro()
    Dim oSl As Slide
    Dim oShs() As Shape

    For Each oSl In ActivePresentation.Slides
        oShs = GetShapes(oSl, msoAutoShape) '<--| gather shapes of given type and...
        ConvertShapesToPics oShs '<--| ...convert them
    Next
End Sub

Function GetShapes(oSl As Slide, shType As MsoShapeType) As Shape()
    Dim oSh As Shape
    Dim nShps As Long

    With oSl.Shapes '<--| reference passed slide Shapes collection
        ReDim oShs(1 To .Count) As Shape '<--| resize shapes array to referenced slide shapes number (i.e. to maximum possible)
        For Each oSh In .Range '<--| loop through referenced slide shapes
            If oSh.Type = shType Then '<--| if its type matches the passed one
                nShps = nShps + 1 '<--| update gathered shapes counter
                Set oShs(nShps) = oSh '<--| fill gathered shapes array
            End If
        Next
    End With
    If nShps > 0 Then '<--| if any shape has been gathered
        ReDim Preserve oShs(1 To nShps) As Shape '<--| resize array properly ...
        GetShapes = oShs '<--| ... and return it
    End If
End Function

Sub ConvertShapesToPics(oShs() As Shape)
    Dim iShp As Long

    If IsArray(oShs) Then '<--| if array has been initialized ...
        For iShp = 1 To UBound(oShs) '<--|... then loop through its elements (shapes)
            ConvertShapeToPic oShs(iShp) '<--| convert current shape
        Next iShp
    End If
End Sub

Sub ConvertShapeToPic(ByRef oSh As Shape)
    With oSh '<--| reference passed shape
        .Fill.ForeColor.RGB = RGB(0, 0, 0) '<--| change its forecolor
        .Copy '<--| copy it
        With .Parent.Shapes.PasteSpecial(ppPastePNG)(1) '<--| reference pasted shape
            .Left = oSh.Left '<--| adjust its Left position
            .Top = oSh.Top '<--| adjust its Top position
            Do
                .ZOrder (msoSendBackward)
            Loop Until .ZOrderPosition = .ZOrderPosition
        End With
        .Delete '<--| delete referenced passed shape
    End With
End Sub

其中Sub nieuwemacro() Dim oSl As Slide For Each oSl In ActivePresentation.Slides ConvertShapesToPics GetShapes(oSl, msoAutoShape) '<--| convert shapes of given type Next End Sub，GetShapes()和ConvertShapesToPics()保持不变。

VBA Else If语句表现得很奇怪

1 个答案: