Merhaba arkadaşlar,
Belgelerimizi klasörlemek için delgeç kullanırken kağıt kenar ortasının işaretli olmasını kim istemez. A4 ebatları için kağıt kenar ortasının işaretlenmesini sağlayan bir makroyu paylaşmak istiyorum.
Belgelerimizi klasörlemek için delgeç kullanırken kağıt kenar ortasının işaretli olmasını kim istemez. A4 ebatları için kağıt kenar ortasının işaretlenmesini sağlayan bir makroyu paylaşmak istiyorum.
Kod:
Sub DelgecOrtaCizgisi()
'Tüm sayfalara A4 ebadına göre "Delgeç için kağıt kenar ortasına işaret" koyan/kaldıran makro...
Dim Sor As String
Sor = MsgBox("Kağıt Kenar Ortası İşaretlensin mi?", vbYesNo, " DELGEÇ KILAVUZU")
If Sor = vbYes Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddShape(msoShapeRightArrow, 2.75, 9.25, _
6.9, 8.25).Select
Selection.ShapeRange.Width = 10.5
Selection.ShapeRange.Height = 10.65
Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = wdThemeColorText1
Selection.ShapeRange.Fill.ForeColor.TintAndShade = 0#
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.Left = 42.8
Selection.ShapeRange.Top = 29.15
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionPage
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionPage
Selection.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage
Selection.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage
Selection.ShapeRange.Left = CentimetersToPoints(0.01)
Selection.ShapeRange.LeftRelative = wdShapePositionRelativeNone
Selection.ShapeRange.Top = CentimetersToPoints(14.85)
Selection.ShapeRange.TopRelative = wdShapePositionRelativeNone
Selection.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
Selection.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
Selection.ShapeRange.LockAnchor = False
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 = 3
Selection.ShapeRange.ZOrder 4
Selection.EscapeKey
Else
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
On Error Resume Next
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.SelectAll
Selection.ShapeRange.Delete
Selection.EscapeKey
End If
End Sub