Delgeç için kağıt kenar ortasına işaret koymak

[necati]

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.

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

 

[Korhan Ayhan]

Merhaba,

Paylaşımınız için çok teşekkür ederim. Yalnız makro 2007 versiyonda hazırlandığı için bazı satırlardaki özellikler eski versiyonlarda olmadığından hata veriyor. Hata veren satırlar pasif yapıldığında kod sayfaların sol kenarındaki orta bölüme objeyi yerleştiriyor.

 

[leumruk]

Merhaba,
Necati Bey, hayal gücünüz muhteşem. Güzel bir düşünce olmuş. Kodlarınızı biraz tıraşlayıp bir kaç ekleme yapıp katkıda bulunmak istedim. Umarım gerekli yerleri de tıraşlamamışımdır.

Sub Makro1()
'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
Application.ScreenUpdating = False
Sor = MsgBox("Kağıt Kenar Ortası İşaretlensin mi?", vbYesNo, "         DELGEÇ KILAVUZU")
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        If Selection.HeaderFooter.Shapes.Count > 0 Then
        Selection.HeaderFooter.Shapes.SelectAll
        Selection.ShapeRange.Delete
    End If
If Sor = vbYes Then
   Selection.HeaderFooter.Shapes.AddShape(msoShapeRightArrow, 42.8, 29.15, 10.5, 10.65).Select
    With Selection.ShapeRange
    .RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = _
        wdRelativeVerticalPositionPage
    .Left = CentimetersToPoints(0.1)
    .Top = CentimetersToPoints(14.85)
    End With
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

 

[necati]

Teşekkür ederim. Bilgisayarımdan ve internetten uzak kaldığım için cevabı şimdi yazabiliyorum kusura bakmayınız. Sizler tarafından kodda bir güzelleştirme yapılması benim de arzu ettiğim bir şeydi. Bu sayede Korhan beyin belirttiği problem de sanırım giderilmiş oldu.

 

[teknadir]

Resimde görülen hata neden kaynaklanıyor olabilir?

 

[leumruk]

Resimde görülen hata neden kaynaklanıyor olabilir?

Merhaba,
Excelde çalıştırmaya çalıştığınız için bu hatayı alıyorsunuz. Kodu wordde çalıştıracaksınız.

 

[teknadir]

Peki nasıl çalışacak bu makro. Word'de denedim. Baskı önizlemede görünmüyor.

 

[leumruk]

Peki nasıl çalışacak bu makro. Word'de denedim. Baskı önizlemede görünmüyor.

3 nolu mesaja örnek bir dosya ekledim. Makro için de bir kısayol atadım. "CTRL Ç" kısayolu ile makroyu çalıştırabilirsiniz. Sayfanın sol orta kısmında silik bir ok göreceksiniz.

 

[teknadir]

3 nolu mesaja örnek bir dosya ekledim. Makro için de bir kısayol atadım. "CTRL Ç" kısayolu ile makroyu çalıştırabilirsiniz. Sayfanın sol orta kısmında silik bir ok göreceksiniz.

Evet, oraya kadara tamam da; belgeyi yazdırdığımızda ok görünecek mi? Baskı önizlemede görünmüyor.

 

[leumruk]

Evet, oraya kadara tamam da; belgeyi yazdırdığımızda ok görünecek mi? Baskı önizlemede görünmüyor.

Bu satırdaki değeri artırırsanız yazıcıdan çıkmasını sağlayabilirsiniz. Örneğin: "0.5" yeterli bir değer olur.

 .Left = CentimetersToPoints(0.01)

 

[teknadir]

Bu makroyu excelde çalıştırmak mümkün mü?
Ok işaretini "-" ile nasıl değiştirebiliriz?

 

[leumruk]

Bu makroyu excelde kullanamazsınız. Word ile excelin çalışma mantığında birçok farklılık vardır. Dolayısıyla wordde hazırlanan bir makronun excelde de kullanılması üzerinde bir takım değişiklikler yapmadan mümkün değildir. Birebir aynısı olmasa da alternatif olabilecek bir takım çözümler düşünülebilir. Örneğin excele eklenecek bir ok resmi kullanılarak bir alternatif düşünülebilir. Bu resim kodlar yardımıyla gizle-göster yöntemi kullanılarak ihtiyacı karşılayabilir. Ancak şunu belirteyim, resim üstbilgi içinde değil sayfanın içinde olacağından verilerin dışında bir yerde değil, bizzat içinde olacaktır. Eğer işimi görür derseniz örnek bir dosya hazırlayayım.

 

[teknadir]

Wordde olugu gibi kenar boslugunda gorunmesini saglayabilir miyiz?

 

[leumruk]

Wordde olugu gibi kenar boslugunda gorunmesini saglayabilir miyiz?

Hayır olmaz diyerek kesin konuşmak istemiyorum. Çıkar birisi yapar, mahcup oluruz. Ben denedim olmadı. Ama daha önce de belirttiğim gibi, sayfa üzerinde olur derseniz, çözüm üretebilirim.

 

[erenpasa]

Word 2003'te çalışmıyor herhalde.