PPT 2007 - VBA - Fotos groeperen via een array

Status
Niet open voor verdere reacties.

RenaatS

Nieuwe gebruiker
Lid geworden
5 mrt 2012
Berichten
3
Ik tracht een stukje VBA code te bouwen waarmee ik alle foto's op een slide kan groeperen, om die dan als 1 picture te exporteren. Het is dus niet de bedoeling de hele slide te exporteren.

Ik heb inmiddels getracht om met een array een range te maken van alle shapes van het type msoPicture maar blijkbaar doe ik daarbij iets fout (ik ben niet echt vertrouwd met arrays en ranges.

Met For Each .... Next ga ik door alle shapes op een pagina en voeg de namen van de shapes van het type msoPicture toe aan een string (=ArrayStr). Als ik die string in een messagebox zet, zie ik iets zoals "Shape 1","Shape 7","Shape 9". Als ik die dan echter in de Range(Array(ArrayStr)) zet, geeft ie aan dat ie de genoemde shapes niet kan vinden in de collectie. Als ik dan over de ArrayStr ga dan zie ik dat hij die toont met extra dubbele quotes. Dat wordt dus Range(Array(""Shape 1","Shape 7","Shape 9""))

Mogelijk is dat dus het probleem.

Kan iemand mij een tip geven hoe ik dit kan doen? Misschien moet ik wel helemaal niet via een range werken. Of wat moet ik doen om die range op te bouwen met alle shapes die msoPicture zijn?

Bedankt voor jullie advies.
 
Je voegt de alles samen in 1 string? dan gaat het niet werken. Tenzij je de string weer omzet naar een array, voordat je het in de functie voedt.

Je moet ofwel een array bouwen vanaf het begin of de string op een speciale manier opbouwen en dan doorgeven aan de functie via "SPLIT"

bijvoorbeeld de strings samenvoegen met "|" en dan daarna weer op splitsen.
 
Tips toegepast, helaas zonder resultaat

Hallo wampier


bedankt voor je tip. Ik heb inmiddels geprobeerd om met de SPLIT functie te werken en ik heb vanaf het begin met een array gewerkt. Helaas doe ik nog steeds iets (waarschijnlijk erg doms) fout. Ik plak hieronder even de code, waarschijnlijk zie jij meteen wat er fout is. Met deze code geeft ie nog steeds de foutmelding "Item Picture 195, Picture 196, Picture 194 not found in Shapes collection" . Als ik dan de waarde van myArray controleer staat daar "myArray = Picture 195, Picture 196, Picture 194"

Nog suggesties wat er fout zit?

Alvast bedankt


Code:
Sub StorePictureCOPY()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shapes
Dim oSH As Shape
Dim myArray As Variant, myRange As ShapeRange
Dim myGroup As Shape
Dim ArrayStr As String

Set oPres = ActivePresentation
Set oSlides = oPres.Slides
    
    PictureName = PictureName & ".jpg"
    
    Set oShapes = oPres.Slides(SlideNr).Shapes
    For Each oSH In oShapes
        If oSH.Type = msoPicture Then
                   
            If myArray = Empty Then
            
                myArray = oSH.Name
                
            Else
            
                myArray = myArray & ", " & oSH.Name
                            
            End If
            
        End If

    Next oSH
    
    Set myRange = ActivePresentation.Slides(SlideNr).Shapes.Range(myArray)
    Set myGroup = myRange.Group
    
    ActivePresentation.Slides(SlideNr).Shapes.Range(myArray).Ungroup
    
    myGroup.Export MyImageLocation & PictureName, ppShapeFormatJPG, , , ppRelativeToSlide
   
End Sub
 
Dat is geen array: Je gebruik een string. Overigens is daar niets mis mee, maar het is niet wat de functie verwacht. Een array is een genummerde lijst waarvan de onderdelen elk apart zijn aan te roepen.

Code:
testarray = array("a","b","c")
msgbox (testarray(0))
msgbox (testarray(1))
msgbox (testarray(2))

De oplossing met string is zo:
Code:
Sub StorePictureCOPY()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shapes
Dim oSH As Shape
Dim myArray As Variant, myRange As ShapeRange
Dim myGroup As Shape
Dim ArrayStr As String

Set oPres = ActivePresentation
Set oSlides = oPres.Slides
    
    PictureName = PictureName & ".jpg"
    
    Set oShapes = oPres.Slides(SlideNr).Shapes
    For Each oSH In oShapes
        If oSH.Type = msoPicture Then
            myArray = myArray & oSH.Name & "|"
        End If
    Next oSH
    myArray = Left(myArray, Len(myArray) - 1)
    Set myRange = ActivePresentation.Slides(SlideNr).Shapes.Range(Split(myArray, "|"))
    Set myGroup = myRange.Group
    
    myRange.Ungroup
    
    myGroup.Export MyImageLocation & PictureName, ppShapeFormatJPG, , , ppRelativeToSlide
   
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan