נכתב ע"י nיה;1064190:זה מה שאני עושה תמיד. אבל:
- העתק הדבק לא שומר לי את הגדרת עמוד, כותרת עליונה ותחתונה וכו'.
- למחוק לפני ואחרי זה המון עבודה כי אני צריכה לגלול את העמוד כמה דקות עד שהוא מוחק את כל העמודים המיותרים.
חשבתי שיש דרך קיצור.
Option Explicit
Sub Test()
Dim Counter As Long, Pages As Long
Dim SourceDoc As Document, TargetDoc As Document
Dim Source As Range, Target As Range
Dim DocName As String
Dim i As Integer
Set SourceDoc = ActiveDocument
Selection.HomeKey Unit:=wdStory
Pages = SourceDoc.BuiltInDocumentProperties(wdPropertyPages)
Counter = 0
While Counter < Pages
Counter = Counter + 1
' To save the files to the same directory as the ActiveDocument
DocName = ActiveDocument.Path & "\" & Format(Counter) & " to " & Format(Counter + 99) & GetFileExt(ActiveDocument.Name)
Set TargetDoc = Documents.Add
For i = 1 To 100
Set Target = TargetDoc.Range
Target.Collapse wdCollapseEnd
SourceDoc.Activate
Set Source = SourceDoc.Bookmarks("\Page").Range
Target.FormattedText = Source.FormattedText
Source.Delete
Next i
TargetDoc.SaveAs FileName:=DocName
TargetDoc.Close
Counter = Counter + 99
Wend
SourceDoc.Close wdDoNotSaveChanges
End Sub
' To save the files to the same directory as the ActiveDocument
DocName = ActiveDocument.Path & "\" & Format(Counter) & " to " & Format(Counter + 1) & GetFileExt(ActiveDocument.Name)
' To choose a folder to save the files to
DocName = BrowseFolder("Select Folder To Save Files") & Format(Counter) & " to " & Format(Counter + 1) & GetFileExt(ActiveDocument.Name)
Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function apiFindWindowA Lib "User32" Alias "FindWindowA" (ByVal sClass As String, ByVal xTitle As Long) As Long
Private Declare Function apiSendMessageA Lib "User32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const WM_USER = 1024
Function fDetectWord() As Long
Dim lngX As Long, objWord As Object
lngX = apiFindWindowA("OpusApp", 0)
If lngX <> 0 Then
'lngX is the hWnd for Word
apiSendMessageA lngX, WM_USER + 18, 0, 0
fDetectWord = lngX
End If
End Function
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, BI As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
With BI
.hOwner = fDetectWord
.lpszTitle = szDialogTitle
.ulFlags = &H1 Or &H40 ' &H40 adds the "Create New Folder" button
End With
dwIList = SHBrowseForFolder(BI)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
נכתב ע"י a26955;1064198:עושים קונטרול +G (עבור אל) בוחרים בצד ימין 'עמוד' ומכניסים מס' עמוד.
הולכים לתחילת העמוד
קונטרול + שיפט + HOME
והטקסט עד תחילת המסמך נבחר.
זהו, DELETE
אותו דבר לסוף המסמך, רק END במקום HOME
ונשארו רק העמודים הרצויים
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
4.06
כ"ז אייר
סילבוס חדש ל-2024!
קורס פיתוח ובניית אתרים
קריירה מתקדמת, ביקוש עצום, וממוצע משכורות גבוה במיוחד!
מלגות גבוהות ומשתלמות!
2.06
כ"ה אייר
פתיחת מסלול
קורס עריכת וידאו
מלגות והנחות משמעותיות!
4.06
כ"ז אייר
#רקבפרוג
הרצאה מרתקת:
הכירו את טווינמושן
עם גל אקסלרוד
עולם מטורף משל הדמיות! ממשק חדשני שמאפשר לבצע הדמיה כמעט כמו משחק מחשב
לתלמידים ובוגרים בלבד!
27.06
כ"א סיוון
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
27.06
כ"א סיוון
השקה חגיגית!
עיצוב גרפי ודיגיטל - בסילבוס חדש ומטורף!
מלגות גבוהות!
תהילים פרק קמז
א הַלְלוּיָהּ כִּי טוֹב זַמְּרָה אֱלֹהֵינוּ כִּי נָעִים נָאוָה תְהִלָּה:ב בּוֹנֵה יְרוּשָׁלִַם יְהוָה נִדְחֵי יִשְׂרָאֵל יְכַנֵּס:ג הָרֹפֵא לִשְׁבוּרֵי לֵב וּמְחַבֵּשׁ לְעַצְּבוֹתָם:ד מוֹנֶה מִסְפָּר לַכּוֹכָבִים לְכֻלָּם שֵׁמוֹת יִקְרָא:ה גָּדוֹל אֲדוֹנֵינוּ וְרַב כֹּחַ לִתְבוּנָתוֹ אֵין מִסְפָּר:ו מְעוֹדֵד עֲנָוִים יְהוָה מַשְׁפִּיל רְשָׁעִים עֲדֵי אָרֶץ:ז עֱנוּ לַיהוָה בְּתוֹדָה זַמְּרוּ לֵאלֹהֵינוּ בְכִנּוֹר:ח הַמְכַסֶּה שָׁמַיִם בְּעָבִים הַמֵּכִין לָאָרֶץ מָטָר הַמַּצְמִיחַ הָרִים חָצִיר:ט נוֹתֵן לִבְהֵמָה לַחְמָהּ לִבְנֵי עֹרֵב אֲשֶׁר יִקְרָאוּ:י לֹא בִגְבוּרַת הַסּוּס יֶחְפָּץ לֹא בְשׁוֹקֵי הָאִישׁ יִרְצֶה:יא רוֹצֶה יְהוָה אֶת יְרֵאָיו אֶת הַמְיַחֲלִים לְחַסְדּוֹ:יב שַׁבְּחִי יְרוּשָׁלִַם אֶת יְהוָה הַלְלִי אֱלֹהַיִךְ צִיּוֹן:יג כִּי חִזַּק בְּרִיחֵי שְׁעָרָיִךְ בֵּרַךְ בָּנַיִךְ בְּקִרְבֵּךְ:יד הַשָּׂם גְּבוּלֵךְ שָׁלוֹם חֵלֶב חִטִּים יַשְׂבִּיעֵךְ:טו הַשֹּׁלֵחַ אִמְרָתוֹ אָרֶץ עַד מְהֵרָה יָרוּץ דְּבָרוֹ:טז הַנֹּתֵן שֶׁלֶג כַּצָּמֶר כְּפוֹר כָּאֵפֶר יְפַזֵּר:יז מַשְׁלִיךְ קַרְחוֹ כְפִתִּים לִפְנֵי קָרָתוֹ מִי יַעֲמֹד:יח יִשְׁלַח דְּבָרוֹ וְיַמְסֵם יַשֵּׁב רוּחוֹ יִזְּלוּ מָיִם:יט מַגִּיד (דברו) דְּבָרָיו לְיַעֲקֹב חֻקָּיו וּמִשְׁפָּטָיו לְיִשְׂרָאֵל:כ לֹא עָשָׂה כֵן לְכָל גּוֹי וּמִשְׁפָּטִים בַּל יְדָעוּם הַלְלוּיָהּ: