Sub PlaceCropmarks()
Dim sngLeft As Single
Dim sngRight As Single
Dim sngTop As Single
Dim sngBottom As Single
Dim sPrintField As String
Dim rng As Range
With ActiveDocument.PageSetup
sngLeft = .LeftMargin
sngRight = .RightMargin
sngTop = .TopMargin
sngBottom = .BottomMargin
End With
' Include initial field switches and PostScript instructions
sPrintField = " \p page " & chr$(34) & " .5 setlinewidth "
' Get correct coordinates using the four functions
sPrintField = sPrintField & BottomLeft(sngLeft, sngBottom)
sPrintField = sPrintField & TopLeft(sngLeft, sngTop)
sPrintField = sPrintField & TopRight(sngRight, sngTop)
sPrintField = sPrintField & BottomRight(sngRight, sngBottom)
' Add final PostScript instruction and close the field instruction
sPrintField = sPrintField & "stroke" & chr$(34)
Set rng = Selection.Sections.First.Headers(wdHeaderFooterPrimary).Range
rng.Collapse wdCollapseStart
rng.Fields.Add Range:=rng, _
Type:=wdFieldPrint, _
Text:=sPrintField, _
PreserveFormatting:=False
End Sub
Function BottomLeft(sngLeft As Single, sngBottom As Single) As String
Dim sReturn As String
sReturn = sngLeft & " " & sngBottom - 2 & " moveto "
sReturn = sReturn & sngLeft & " " & (sngBottom - 2) - 36 & " lineto "
sReturn = sReturn & sngLeft - 2 & " " & sngBottom & " moveto "
sReturn = sReturn & (sngLeft - 2) - 36 & " " & sngBottom & " lineto "
BottomLeft = sReturn
End Function
Function TopLeft(sngLeft As Single, sngTop As Single) As String
Dim sReturn As String
sReturn = sngLeft & " " & (792 - sngTop) + 2 & " moveto "
sReturn = sReturn & sngLeft & " " & (792 - (sngTop + 2)) + 36 & " lineto "
sReturn = sReturn & sngLeft - 2 & " " & 792 - sngTop & " moveto "
sReturn = sReturn & (sngLeft - 2) - 36 & " " & 792 - sngTop & " lineto "
TopLeft = sReturn
End Function
Function TopRight(sngRight As Single, sngTop As Single) As String
Dim sReturn As String
sReturn = 612 - sngRight & " " & (792 - sngTop) + 2 & " moveto "
sReturn = sReturn & 612 - sngRight & " " & (792 - (sngTop + 2)) + 36 & " lineto "
sReturn = sReturn & (612 - sngRight) + 2 & " " & 792 - sngTop & " moveto "
sReturn = sReturn & ((612 - sngRight) + 2) + 36 & " " & 792 - sngTop & " lineto "
TopRight = sReturn
End Function
Function BottomRight(sngRight As Single, sngBottom As Single) As String
Dim sReturn As String
sReturn = 612 - sngRight & " " & sngBottom - 2 & " moveto "
sReturn = sReturn & 612 - sngRight & " " & (sngBottom - 2) - 36 & " lineto "
sReturn = sReturn & (612 - sngRight) + 2 & " " & sngBottom & " moveto "
sReturn = sReturn & ((612 - sngRight) + 2) + 36 & " " & sngBottom & " lineto "
BottomRight = sReturn
End Function
נכתב ע"י קרש;714329:מאקרו להוסיף סימני חיתוך לשוליים בוורד. מתוך ספר Word Hacks של o'reilly.
הסימנים מופיעים רק בהדפסה למדפסת PostScript או בפידיאף.
קוד:Sub PlaceCropmarks() Dim sngLeft As Single Dim sngRight As Single Dim sngTop As Single Dim sngBottom As Single Dim sPrintField As String Dim rng As Range With ActiveDocument.PageSetup sngLeft = .LeftMargin sngRight = .RightMargin sngTop = .TopMargin sngBottom = .BottomMargin End With ' Include initial field switches and PostScript instructions sPrintField = " \p page " & chr$(34) & " .5 setlinewidth " ' Get correct coordinates using the four functions sPrintField = sPrintField & BottomLeft(sngLeft, sngBottom) sPrintField = sPrintField & TopLeft(sngLeft, sngTop) sPrintField = sPrintField & TopRight(sngRight, sngTop) sPrintField = sPrintField & BottomRight(sngRight, sngBottom) ' Add final PostScript instruction and close the field instruction sPrintField = sPrintField & "stroke" & chr$(34) Set rng = Selection.Sections.First.Headers(wdHeaderFooterPrimary).Range rng.Collapse wdCollapseStart rng.Fields.Add Range:=rng, _ Type:=wdFieldPrint, _ Text:=sPrintField, _ PreserveFormatting:=False End Sub Function BottomLeft(sngLeft As Single, sngBottom As Single) As String Dim sReturn As String sReturn = sngLeft & " " & sngBottom - 2 & " moveto " sReturn = sReturn & sngLeft & " " & (sngBottom - 2) - 36 & " lineto " sReturn = sReturn & sngLeft - 2 & " " & sngBottom & " moveto " sReturn = sReturn & (sngLeft - 2) - 36 & " " & sngBottom & " lineto " BottomLeft = sReturn End Function Function TopLeft(sngLeft As Single, sngTop As Single) As String Dim sReturn As String sReturn = sngLeft & " " & (792 - sngTop) + 2 & " moveto " sReturn = sReturn & sngLeft & " " & (792 - (sngTop + 2)) + 36 & " lineto " sReturn = sReturn & sngLeft - 2 & " " & 792 - sngTop & " moveto " sReturn = sReturn & (sngLeft - 2) - 36 & " " & 792 - sngTop & " lineto " TopLeft = sReturn End Function Function TopRight(sngRight As Single, sngTop As Single) As String Dim sReturn As String sReturn = 612 - sngRight & " " & (792 - sngTop) + 2 & " moveto " sReturn = sReturn & 612 - sngRight & " " & (792 - (sngTop + 2)) + 36 & " lineto " sReturn = sReturn & (612 - sngRight) + 2 & " " & 792 - sngTop & " moveto " sReturn = sReturn & ((612 - sngRight) + 2) + 36 & " " & 792 - sngTop & " lineto " TopRight = sReturn End Function Function BottomRight(sngRight As Single, sngBottom As Single) As String Dim sReturn As String sReturn = 612 - sngRight & " " & sngBottom - 2 & " moveto " sReturn = sReturn & 612 - sngRight & " " & (sngBottom - 2) - 36 & " lineto " sReturn = sReturn & (612 - sngRight) + 2 & " " & sngBottom & " moveto " sReturn = sReturn & ((612 - sngRight) + 2) + 36 & " " & sngBottom & " lineto " BottomRight = sReturn End Function
נכתב ע"י Yisrael;714997:לא רואה כלום ב-PDF...
נכתב ע"י אלחנן אריאל;715100:בבקשה!
נכתב ע"י Yisrael;716052:עדיין לא רואה כלום אחרי הייצוא...
יכול להיות שזה בגלל שאני שומר ב-PDF ע"י הפונקציה המובנית בוורד?
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
4.06
כ"ז אייר
קורס משולב בינה מלאכותית
קורס פיתוח ובניית אתרים
קריירה מתקדמת, ביקוש עצום, וממוצע משכורות גבוה במיוחד!
מלגות גבוהות ומשתלמות!
2.06
כ"ה אייר
פתיחת מסלול
קורס עריכת וידאו
מלגות והנחות משמעותיות!
4.06
כ"ז אייר
#רקבפרוג
הרצאה מרתקת:
הכירו את טווינמושן
עם גל אקסלרוד
עולם מטורף משל הדמיות! ממשק חדשני שמאפשר לבצע הדמיה כמעט כמו משחק מחשב
לתלמידים ובוגרים בלבד!
27.06
כ"א סיוון
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
27.06
כ"א סיוון
השקה חגיגית!
עיצוב גרפי ודיגיטל - בסילבוס חדש ומטורף!
מלגות גבוהות!
תהילים פרק א
א אַשְׁרֵי הָאִישׁ אֲשֶׁר לֹא הָלַךְ בַּעֲצַת רְשָׁעִים וּבְדֶרֶךְ חַטָּאִים לֹא עָמָד וּבְמוֹשַׁב לֵצִים לֹא יָשָׁב:ב כִּי אִם בְּתוֹרַת יְהוָה חֶפְצוֹ וּבְתוֹרָתוֹ יֶהְגֶּה יוֹמָם וָלָיְלָה:ג וְהָיָה כְּעֵץ שָׁתוּל עַל פַּלְגֵי מָיִם אֲשֶׁר פִּרְיוֹ יִתֵּן בְּעִתּוֹ וְעָלֵהוּ לֹא יִבּוֹל וְכֹל אֲשֶׁר יַעֲשֶׂה יַצְלִיחַ:ד לֹא כֵן הָרְשָׁעִים כִּי אִם כַּמֹּץ אֲשֶׁר תִּדְּפֶנּוּ רוּחַ:ה עַל כֵּן לֹא יָקֻמוּ רְשָׁעִים בַּמִּשְׁפָּט וְחַטָּאִים בַּעֲדַת צַדִּיקִים:ו כִּי יוֹדֵעַ יְהוָה דֶּרֶךְ צַדִּיקִים וְדֶרֶךְ רְשָׁעִים תֹּאבֵד: