PDA

View Full Version : Feformatting a page !



crazy1
10-23-2021, 07:19 AM
This macro has been programmed long ago . I wanted to make very thin margins , justify paragraphs (ctrl J) to full, condense paragraphs and add page numbers .Sadly the page numbers are 'boxed' texts.It works great!
The only i could not carry out is to shrink all photos on a given size and keep the insert page wihtout 'textbox'



Sub s()
Selection.WholeStory
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(1)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
With Selection.Find
.Text = "^l"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
Selection.WholeStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
Selection.HomeKey Unit:=wdStory
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
Selection.HomeKey Unit:=wdStory
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.ParagraphFormat
.SpaceBefore = PixelsToPoints(0)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LineUnitBefore = PixelsToPoints(0)
End With
Selection.Sections(1).Headers(1).PageNumbers.Add PageNumberAlignment:= _
wdAlignPageNumberCenter, FirstPage:=True
Selection.WholeStory
Selection.Font.Color = wdColorAutomatic
With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(0.82)
End With
End Sub