kusura bakmayın yoğunluktan hemen cevap veremedim.
bu işi yapacak küçük bi makro hazırladım. aşağıdaki adımlarla uygulayabilirsiniz...
Makro Kodları; (Bunları yukarıda anlatılan yere kopyala-yapıştır yapınız) '------------------------------------------------------------------
Public Sub ebat()
Dim i As Integer
Dim en, boy As Integer
Dim bul As Shape
Dim cerceve As Shape
For i = 1 To ActiveDocument.Pages.Count
ActiveDocument.Pages(i).Activate
' sayfa ebatında renksiz çerçeve atıyoruz...
Set cerceve = ActiveLayer.CreateRectangle(ActivePage.LeftX, ActivePage.TopY, ActivePage.RightX, ActivePage.BottomY)
cerceve.Fill.ApplyNoFill
cerceve.Outline.SetProperties 0#, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 0), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=5#
' sayfadaki tüm çalışmaların grubunu bozuyoruz....
ActiveDocument.Pages(i).Shapes.All.UngroupAll
' sayfadaki tüm vektörel nesneleri konvertliyoruz....
ActiveDocument.Pages(i).Shapes.FindShapes(, cdrTextShape).ConvertToCurves
' sayfadaki tüm çalışmayı yeniden grupluyoruz....
ActiveDocument.Pages(i).Shapes.All.Group
' a3'den a4'e küçültme işlemi....
Set bul = ActiveSelection
en = ActiveSelection.SizeWidth
boy = ActiveSelection.SizeHeight
bul.SetSize 210, 297
Set bul = ActiveSelection
Next i
For i = 1 To ActiveDocument.Pages.Count
ActiveDocument.Pages(i).SizeHeight = 297
ActiveDocument.Pages(i).SizeWidth = 210
Next i
End Sub
'------------------------------------------------------------------
