Word-ben van valami gyors módi arra, hogy a bemásolt képeket szövegrészhatártól-szövegrészhatárig automatikusan átméretezze?
Sokszor van az, hogy valami honlapról kimásolok egy hosszabb szöveget, ami képeket is tartalmaz. A honlapon szépen mutat, de a wordben "bazinagy" vagy "űberkicsi" lesz a kép, lelóg.
A szövegnél ugye ha a stílusban módosítom mondjuk sorkizártra, akkor az azonnal betördelődik, de a kép ugyanúgy lelógva marad, és egyesével 16cm-re átméretezni nagyon macerás. Vagy marad az, hogy csinálok egy külön "kép" sablont beformázva és egyesével rájuknyomkodom?
válasza:Mondjuk makróval.
Itt írnak egyet, hogy egy kijelölt szövegrész összes képét (alakzatát) megadott méretre (6" szélesre) állítja:
A közvetlen VisualBasic kód, ha nem találnád:
' Resizes selected pictures to 6" wide
On Error Resume Next
Dim oShp As Shape
Dim iShp As InlineShape
Dim ShpScale As Double
With Selection
For Each iShp In .InlineShapes
With iShp
If .Type = wdInlineShapePicture Or wdInlineShapeLinkedPicture Then
ShpScale = InchesToPoints(6) / .Width
.Width = .Width * ShpScale
.Height = .Height * ShpScale
End If
End With
Next iShp
End With
válasza:Nézet szalagfül / Makrók / Makrók megjelenítése / Makrónévhez írj be egy nevet, ami alapján megjegyzed mit csinál / Létrehozás / a megnyíló ablakban az End Sub előtti bekezdésbe kattints, másold be innen az előző hozzászóló által beírt kódsorozatot / Ctrl+S billentyűkombinációval mentsd el.
Ha le akarod futtatni, akkor a Makrók megjelenítése párbeszédpanelben jelöld meg a korábban elkészített makrót, és kattintsd az Indítás gombra.
Köszönöm!
Ez sikeresen megvan, s a normal dot-hoz társítva mindig kéznél is van. A cm-re történő hallgatásra miként kell átírni azt a sort ahol a 6-os szerepel?
Így néz ki most a makróm:
Sub képszélesség()
'
' képszélesség Makró
'
'
' Resizes selected pictures to 6" wide
On Error Resume Next
Dim oShp As Shape
Dim iShp As InlineShape
Dim ShpScale As Double
With Selection
For Each iShp In .InlineShapes
With iShp
If .Type = wdInlineShapePicture Or wdInlineShapeLinkedPicture Then
ShpScale = InchesToPoints(6) / .Width
.Width = .Width * ShpScale
.Height = .Height * ShpScale
End If
End With
Next iShp
End With
End Sub
A makrórögzítést is kipróbáltam, menne is, de csak egy szomorú kockaarc jelenik meg és nem tudom rögzíteni a lépéseket. Valahol le lehet tiltva valami?
2010-es office.
válasza:A linkelt weboldalon írják, hogy képmódosításnál nem működik a makrórögzítés.
InchesToPoints() függvény helyett használj CentimetersToPoints() függvényt.
Pl. 4.5cm >> CentimetersToPoints(4.5)
válasza:Közben eszembe jutott, hogy ha nem mindig ugyanazt a szélességet használnád, akkor a makró elejére írhatsz bevitelt is, hogy ne kelljen mindig átszerkeszteni, pl.:
Sub képszélesség()
...
Dim kepSzelesseg As String
kepSzelesseg = InputBox("Hány centi szélesek legyenek a képek?", "", 5)
...
...CentimetersToPoints(kepSzelesseg)...
...
End Sub
Egy billentyűkombinációval szinte villámgyors lesz.
Hűha, hűha! Alakul ez!
És olyat is lehet ami a függőlegest is állítja, (méretarányt megtartva, illetve azoknál csináljak egy külön függőlegesre kihegyezett makrót?
válasza:Több beviteli mező már macerásabb.
Inkább egy mezőbe írnám, mondjuk vesszővel elválasztva - aztán az mentén darabolni:
(kicsit egyszerűsítettem az eredeti kódon, illetve pár megjegyzés is szerepel)
Sub Méretezés()
Dim kepSzelessegMagassag As String
Dim kepSzelesseg, kepMagassag As Long
kepSzelessegMagassag = InputBox("Szélesség,magasság:", "", "4,3")
kepSzelesseg = CentimetersToPoints(Split(kepSzelessegMagassag, ",")(0))
kepMagassag = CentimetersToPoints(Split(kepSzelessegMagassag, ",")(1))
On Error Resume Next
Dim kep As InlineShape
For Each kep In Selection.InlineShapes
If kep.Type = wdInlineShapePicture Or wdInlineShapeLinkedPicture Then
If (kepSzelesseg = 0) Then
'csak a magasság változik, mert a képarány alapértelmezésben rögzített, így a másik méret automatikusan igazodik
kep.Height = kepMagassag
ElseIf (kepMagassag = 0) Then
'hasonlóan az előzőhöz
kep.Width = kepSzelesseg
Else
'ha egyik sem nulla, akkor a képarány rögzítését fel kell oldani
kep.LockAspectRatio = msoFalse
kep.Width = kepSzelesseg
kep.Height = kepMagassag
kep.LockAspectRatio = msoTrue
End If
End If
Next kep
End Sub
Nagyon szuper!!!
Még 1 kérésem lenne. A középre igazítás is beletehető? Mármint csak a képek középre igazítása, a szövegeké nem.
További kérdések:
Minden jog fenntartva © 2024, www.gyakorikerdesek.hu
GYIK | Szabályzat | Jogi nyilatkozat | Adatvédelem | Cookie beállítások | WebMinute Kft. | Facebook | Kapcsolat: info(kukac)gyakorikerdesek.hu
Ha kifogással szeretne élni valamely tartalommal kapcsolatban, kérjük jelezze e-mailes elérhetőségünkön!