Formatera flera bilder på en gång?

[Meodeo #1]

Jag har ett dokument som alla bilder ska vara lika stora, kan man göra nåt makro som formaterar alla bilder likadant? Eller åtminstone namnspecifika bilder ex. bild1, bild2 osv men ej banner1, banner3?

 

[Monshi]

Ja du, ingen expart på VBA för Word, men jag försöker...

 

1: Dina bilder måste vara "flytande", dvs ej ligga "inline". Inline är de när du klistrat in en bild precis, när den har svart ram omkring sig.

 

2: Någon "rakt på sak" metod hittar jag inte. Det bästa jag kan ordna, med mina kunskaper, är följande kod:

Sub DummySizer()


   Dim index(3) As Integer
   Dim i As Integer
   index(1) = 2
   index(2) = 5
   index(3) = 3
   For i = 1 To UBound(index)
       ActiveDocument.Shapes("Picture " & index(i)).Select
       Selection.ShapeRange.Width = 40
       Selection.ShapeRange.Height = 40
   Next i


End Sub

 

Jag hoppas att det kan hjälpa dig. Lite dumt är det att denna sats inte fungerar:

        For Each sh In .Shapes
           .Select
           Selection.ShapeRange.Width = 80

       Next sh

 

På en ensklid Shape går det inte heller att sätta en exakt storlek, den går enbart att ändra storleken relativt på, man måste på något sätt föra över ett Shape objekt till en ShapeRange.

 

Det finns exempel i VBA hjälpen för Word på olika sätt att skapa en ShapeRange. Men jag tror nog att det jag givit dig ovan kanske ska räcka.

 

Berätta hur det går!

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

[Meodeo #1]

Jag spelade in ett makro där jag markerade dem bilder som skulle se likadana ut och sen ändrade inställningarna på dem. Bara ett problem: hur döper man om bilderna? Nu står det Picture 157 och framåt men jag vill ha Picture 01, Picture 02 osv.

 

Så här ska det bli när bilderna har rätt namn:

[log]Sub Bildstorlek()

 

On Error Resume Next

ActiveDocument.Shapes.Range(Array("Picture 01", "Picture 02", "Picture 03", "Picture 04", "Picture 05", "Picture 06", "Picture 07", "Picture 08", "Picture 09", "Picture 10", "Picture 11")).Select

Selection.ShapeRange.Height = CentimetersToPoints(12.7)

Selection.ShapeRange.Fill.Visible = msoFalse

Selection.ShapeRange.Line.Visible = msoFalse

Selection.ShapeRange.LockAspectRatio = msoTrue

Selection.ShapeRange.Rotation = 0#

Selection.ShapeRange.PictureFormat.Brightness = 0.5

Selection.ShapeRange.PictureFormat.Contrast = 0.5

Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic

Selection.ShapeRange.RelativeHorizontalPosition = _

wdRelativeHorizontalPositionMargin

Selection.ShapeRange.RelativeVerticalPosition = _

wdRelativeVerticalPositionMargin

Selection.ShapeRange.Left = wdShapeCenter

Selection.ShapeRange.Top = wdShapeTop

Selection.ShapeRange.LockAnchor = True

Selection.ShapeRange.LayoutInCell = True

Selection.ShapeRange.WrapFormat.AllowOverlap = True

Selection.ShapeRange.WrapFormat.Side = wdWrapBoth

Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)

Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)

Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)

Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)

Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom

 

End Sub[/log]

 

[Monshi]

Mmh, du fick det alltså att fungera genom att spela in ett makro... Det var det som inte vill fungera riktigt för mig.

 

Men byta namn, enklast är nog att välja bilden för hand och sedan köra detta makro:

Sub PicNamer()
On Error GoTo errorHandler
       newName = InputBox("Ge bilden ett nytt namn", "Namn", Selection.ShapeRange.Name)
       If (newName <> "") Then
           Selection.ShapeRange.Name = newName
       End If
Exit Sub
errorHandler:
   MsgBox "Ingen bild vald"
End Sub

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.