Opgelost Opmaak objecten (foto) wijzigen vanuit VBA

[HansFRAP]

Probleem
Ik werk met een Word driekolommen document. Op verschillende plaatsen komen foto's te staan.
Verschillende foto's worden over meer kolommen getrokken. Tekst van die kolommen gaat er dan goed omheen.
De indeling van de foto's zou ik via knopje willen zetten. Standaard krijgen ze indelingsoptie: In tekstregel
Nu zou ik via knopje (naar VBA-code) wat instellingen op elke foto willen zetten.

Vraag: Met welke code kan ik opmaak van foto in dialoog: Indeling aanpassen
- Tabblad: Positie
- Horz. Uitlijnen: Links tov Kolom
- Tabblad: Tekstterugloop
- Terugloopstijl: Omkader
- Tekstterugloop: Weerszijde
- Afstand tot tekst
- Boven: 0,32 cm
- Onder: 0,32 cm

Pogingen:
- Macro opnemen => Geen opname resultaat
- Omdat het een object is, kan ik geen opmaak stijl maken
- Met selecteren foto - Afbeeldingsinstelling - Tekstterugloop - Instellen als standaardindeling
=> wordt de afstand tot tekst niet vastgehouden
- Opzet gemaakt op basis van Sendkeys maar

Voor de code kan er vanuit gegaan worden dat er reeds een foto is geselecteerd.
Loopje om alle foto's uit document aan te passen, is dus niet nodig.

Hoor graag of dit kan.

 

[AHulpje]

Een voorzetje:

Sub ImageProperties()
'- Horz. Uitlijnen: Links tov Kolom
'- Tabblad: Tekstterugloop
'- Terugloopstijl: Omkader      = wdWrapSquare
'- Tekstterugloop: Weerszijde   = wdWrapBoth
'- Afstand tot tekst
'- Boven: 0,32 cm   WrapFormat.DistanceTop
'- Onder: 0,32 cm   WrapFormat.DistanceBottom

'RelativeHorizontalPosition
'wdRelativeHorizontalPositionCharacter       3   Relative to character.
'wdRelativeHorizontalPositionColumn          2   Relative to column.
'wdRelativeHorizontalPositionMargin          0   Relative to margin.
'wdRelativeHorizontalPositionPage            1   Relative to page.
'wdRelativeHorizontalPositionInnerMarginArea 6   Relative to inner margin area.
'wdRelativeHorizontalPositionLeftMarginArea  4   Relative to left margin.
'wdRelativeHorizontalPositionOuterMarginArea 7   Relative to outer margin area.
'wdRelativeHorizontalPositionRightMarginArea 5   Relative to right margin.

'WrapFormat.Type
'wdWrapInline    7   Places shapes in line with text.
'wdWrapNone      3   Places shape in front of text. See also wdWrapFront.
'wdWrapSquare    0   Wraps text around the shape. Line continuation is on the opposite side of the shape.
'wdWrapThrough   2   Wraps text around the shape.
'wdWrapTight     1   Wraps text close to the shape.
'wdWrapTopBottom 4   Places text above and below the shape.
'wdWrapBehind    5   Places shape behind text.
'wdWrapFront     3   Places shape in front of text. See also wdWrapNone.

'WrapFormat.Side
'wdWrapBoth      0   Both sides of the specified shape.
'wdWrapLargest   3   Side of the shape that is farthest from the page margin.
'wdWrapLeft      1   Left side of shape only.
'wdWrapRight     2   Right side of shape only.

    For Each shp In Shapes
        If shp.Type = msoPicture Then
            Debug.Print shp.Name
            Debug.Print shp.RelativeHorizontalPosition  '2
            Debug.Print shp.WrapFormat.Type             '0
            Debug.Print shp.WrapFormat.Side             '0
            Debug.Print shp.WrapFormat.DistanceTop      '9,07 = centimeterstopoints(0.32)
            Debug.Print shp.WrapFormat.DistanceBottom   '9,07
        End If
    Next
End Sub

 

[HansFRAP]

@AHulpje Alvast dank voor opzet. Ik ga hier morgen vroeg mee aan de slag.
Soort dauwtrappen!

 

[AHulpje]

Om daar nou vroeg voor op te staan:

Sub FotoInstellingen()
    If Selection.Type = wdSelectionShape Then
        With ActiveDocument.Shapes(Selection.ShapeRange.Name)
            Debug.Print .Name
            .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
            .WrapFormat.Type = wdWrapSquare
            .WrapFormat.Side = wdWrapBoth
            .WrapFormat.DistanceTop = CentimetersToPoints(0.32)
            .WrapFormat.DistanceBottom = CentimetersToPoints(0.32)
        End With
    Else
        MsgBox "Selecteer eerst een foto", vbInformation, "Geen foto geselecteerd"
    End If
End Sub

 

[HansFRAP]

@AHulpje
Ik heb wat zitten rommelen met je opzetjes.
Helaas werkt het niet zoals ik verwacht. De code loopt niet door op het moment dat er een foto geselecteerd is.
Onderstaande code loopt wel door, mits er dus vooraf geen foto geselecteerd is en je het nummer van de foto (Afbeelding) correct hebt ingevuld.

Sub FotoInstellingen()
Dim Shp As Shape
Dim Message, Title, Default
Dim FotoNm As String
    Message = "Afbeelding "
    Title = "Vul aan met nummer van de: Afbeelding"
    Default = "Afbeelding "
    FotoNm = InputBox(Message, Title, Default)
    With ActiveDocument
        For Each Shp In .shapes
            If Shp.Name = FotoNm Then
                With Shp
                    'Debug.Print .Name
                    .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
                    .WrapFormat.Type = wdWrapSquare
                    .WrapFormat.Side = wdWrapBoth
                    .WrapFormat.DistanceTop = CentimetersToPoints(0.32)
                    .WrapFormat.DistanceBottom = CentimetersToPoints(0.32)
                End With
            End If
        Next Shp
    End With
End Sub

 

[AHulpje]

Bij mij werkt het prima, Wat bedoel je met "de code loopt niet door"? Krijg je een foutmelding?
Wat is het resultaat van Debug.Print .Name?

 

[HansFRAP]

Debug.Print .Name geeft geen resultaat als ik een foto geselecteerd heb.
Ik krijg ook geen error melding oid.
Als ik door de code heen loop met F8 dan stopt de debug op de regel: Debug.Print.Name.
(Blijft dus gewoon geel, regel gaat niet verder na F8)
Deselecteer ik de foto dan heeft de code dus een probleem want er is geen selectie.

 

[HansFRAP]

Het zou bij mij dus mooi zijn als de code de naam van het geselecteerde object ophaalt, selectie opheffen en dan de settings doorvoerd. Ik hoef dan geen nummer oid in te voeren.

Er komen dan twee vragen bij:-
- Hoe haal je de naam van het object op en
- Hoe hef ik de selectie (met code) weer op.

 

[AHulpje]

Als je een breakpoint zet in de code, daarna een foto selecteert en daarna de macro start dan blijft hij inderdaad hangen op het breakpoint. De-selecteer je op dat moment de foto (door elders in het document te klikken) dan loopt de macro wel door met F8.
Overigens kun je in bericht #2 zien hoe je de naam van een shape tevoorschijn tovert.
Zie ook bijlage met twee macro's.

 

[HansFRAP]

AHulpje mijn dank!