طير البحر قام بنشر مارس 22 مشاركة قام بنشر مارس 22 اخواني استخدم هذا الكود لحذف الصفحات الفارغة برمجيا من ملف وورد وحصلت على نسخ عديدة من الكوت من chat gpt لكن الامر لم يفلح وكل مرة الكود يسلك سلوك مختلف هل ساعدتموني اريد ان احذف الصفحات الفارغة من ملف وورد برمجيا وهذا الكود Sub DeleteEmptyPages() Dim objWord As Object Dim objDoc As Object Dim i As Integer Set objWord = CreateObject("Word.Application") objWord.Visible = False ' Make Word invisible ' Open the document Set objDoc = objWord.Documents.Open(CurrentProject.Path & "\PDFs\" & Forms!SCANTOPDF!fileno.Value & ".docx") ' Delete empty pages For i = objDoc.content.ComputeStatistics(2) To 1 Step -1 If IsPageEmpty(objDoc, i) Then objDoc.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i objDoc.Bookmarks("\page").Range.Delete ' Delete the page Exit For ' Exit the loop to avoid issues with deleted page numbering End If Next i ' Save and close the document objDoc.Save objDoc.Close ' Quit Word objWord.Quit ' Release the objects Set objWord = Nothing Set objDoc = Nothing End Sub Function IsPageEmpty(doc As Object, pageNumber As Integer) As Boolean ' Check if the specified page is empty or contains only system-generated content Dim content As String Dim shape As Object Dim para As Object ' Get the content of the page content = doc.Range(doc.GoTo(What:=1, Which:=1, Count:=pageNumber).Start, doc.GoTo(What:=1, Which:=1, Count:=pageNumber).End).Text ' Check if the content is empty or only contains system-generated text (e.g., page breaks, section breaks, etc.) If Len(Trim(content)) > 50 Then ' If the content is not empty, check if it's only system-generated text For Each para In doc.Range(doc.GoTo(What:=1, Which:=1, Count:=pageNumber)).Paragraphs If para.Range.Information(wdActiveEndPageNumber) = pageNumber Then ' If the paragraph is on the specified page, check if it's system-generated If para.Range.Text Like "*(Page)*" Then ' If it's system-generated text, continue to the next paragraph ' You can add more conditions here to check for other system-generated text Else ' If it's actual content, the page is not empty IsPageEmpty = False Exit Function End If End If Next para End If ' If no actual content is found, the page is empty IsPageEmpty = True End Function رابط هذا التعليق شارك More sharing options...
Foksh قام بنشر مارس 22 مشاركة قام بنشر مارس 22 (معدل) قد يكون هذا الكود لا يتعامل مع الصفحات الفارغة والتي قد تحتوي على مسافات فارغة ، جرب هذا التعديل من شات جي بي تي Sub DeleteEmptyPages() Dim objWord As Object Dim objDoc As Object Dim i As Integer Set objWord = CreateObject("Word.Application") objWord.Visible = False ' Make Word invisible ' Open the document Set objDoc = objWord.Documents.Open(CurrentProject.Path & "\PDFs\" & Forms!SCANTOPDF!fileno.Value & ".docx") ' Delete empty pages For i = objDoc.content.ComputeStatistics(2) To 1 Step -1 If IsPageEmpty(objDoc, i) Then objDoc.GoTo What:=1, Which:=1, Count:=i objDoc.Range.Delete End If Next i ' Save and close the document objDoc.Save objDoc.Close ' Quit Word objWord.Quit ' Release the objects Set objWord = Nothing Set objDoc = Nothing End Sub Function IsPageEmpty(doc As Object, pageNumber As Integer) As Boolean ' Check if the specified page is empty or contains only whitespace characters Dim content As String ' Get the content of the page content = doc.Range(doc.GoTo(1, 1, pageNumber).Start, doc.GoTo(1, 1, pageNumber).End).Text ' Check if the content is empty or only contains whitespace characters IsPageEmpty = Trim(content) = "" End Function طبعاً لم تتم تجربته تم تعديل مارس 22 بواسطه Foksh رابط هذا التعليق شارك More sharing options...
طير البحر قام بنشر مارس 22 الكاتب مشاركة قام بنشر مارس 22 الاخ @Foksh لقد جربت اكثر من 100 اقتراح من chat gpt لكنه مارس عليا الغباء الصناعي ههههه 1 رابط هذا التعليق شارك More sharing options...
Foksh قام بنشر مارس 22 مشاركة قام بنشر مارس 22 استخدام الذكاء الاصطناعي يحتاج اسلوب شرح وتوضيح معطيات كثيرة حتى تصل المطلوب منه. وهو يعطيك النتائج حسب الشرح المقدم له ، وقد تحتاج لذكر الاحتمالات جميعها له حتى يتجاوب معك بالشكل المطلوب 😅 1 رابط هذا التعليق شارك More sharing options...
طير البحر قام بنشر مارس 22 الكاتب مشاركة قام بنشر مارس 22 اخي @Foksh ارجو ان استطعت المساعدة بمثال رابط هذا التعليق شارك More sharing options...
Foksh قام بنشر مارس 22 مشاركة قام بنشر مارس 22 حالياً ليس لدي جهاز كمبيوتر ، لكن ليوم الغد إن شاء الله سأحاول ارفاق تجربة موثقة ، إن لم يسبقني أحد الاساتذة 😊 1 رابط هذا التعليق شارك More sharing options...
سامي الحداد قام بنشر مارس 23 مشاركة قام بنشر مارس 23 السلام عليكم هذه مشاركتي مع الاخوة الكرام. Option Compare Database Option Explicit Private Sub Command0_Click() CleanUpWordDocument End Sub Public Function DeleteBlankPages(wd As Word.Document) Dim par As Paragraph For Each par In wd.Paragraphs If Len(par.Range.Text) <= 1 Then par.Range.Delete End If Next par End Function Public Sub CleanUpWordDocument() Dim wdApp As New Word.Application Dim wdDoc As Word.Document Set wdDoc = wdApp.Documents.Open("C:\Users\LENOVO\Documents\Test1.docx")' استبدل المسار DeleteBlankPages wdDoc MsgBox "تمت عملية حذف الصفحات الفارغة", vbInformation + vbMsgBoxRight, "تأكيد" wdDoc.Save wdDoc.Close wdApp.Quit Set wdDoc = Nothing Set wdApp = Nothing End Sub بالتوفيق رابط هذا التعليق شارك More sharing options...
Foksh قام بنشر مارس 23 مشاركة قام بنشر مارس 23 (معدل) 12 ساعات مضت, Foksh said: حالياً ليس لدي جهاز كمبيوتر ، لكن ليوم الغد إن شاء الله سأحاول ارفاق تجربة موثقة ، إن لم يسبقني أحد الاساتذة 😊 تفضل يا صديقي ، الكود بعد إجراء بعض التعديلات على كودي السابق وكود الأستاذ @سامي الحداد طبعاً يجب إضافة مكتبة "Microsoft Word XX.X Object Library" حيث XX.X هو إصدار مايكروسوفت أوفيس لديك Option Compare Database Option Explicit Option Base 1 Private Sub Command0_Click() CleanUpWordDocument End Sub Public Sub CleanUpWordDocument() Dim wdApp As Object Dim wdDoc As Object On Error Resume Next Set wdApp = GetObject(, "Word.Application") On Error GoTo 0 If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application") End If Set wdDoc = wdApp.Documents.Open(CurrentProject.Path & "\PDFs\" & Me.fileno.Value & ".docx") DeleteEmptyPages wdDoc wdDoc.Close True wdApp.Quit Set wdDoc = Nothing Set wdApp = Nothing MsgBox "تمت عملية حذف الصفحات الفارغة", vbInformation + vbMsgBoxRight, "تأكيد" End Sub Public Sub DeleteEmptyPages(wdDoc As Object) Dim i As Long Dim pageCount As Long Dim rng As Object pageCount = wdDoc.Range.ComputeStatistics(2) For i = pageCount To 1 Step -1 Set rng = wdDoc.GoTo(1, 1, i) If Len(Trim(rng.Text)) = 0 Then rng.Delete End If Next i End Sub 01010.accdb وأخبرني بالنتيجة تم تعديل مارس 23 بواسطه Foksh رابط هذا التعليق شارك More sharing options...
طير البحر قام بنشر مارس 24 الكاتب مشاركة قام بنشر مارس 24 الاخ @سامي الحداد للاسف لم يؤدي الكود الوظيفة المرجوة الاخ @Foksh الكود يحذف الحرف الاول من الفقرة الاولى اذا كانت فقرة وحيدة ويحذف الصور لقد مررت بكل هذه التجارب تقريبا او بتجارب مماثلة ولم اصل لنتيجة اشكر مجهودكم والباب مازال مفتوحا لنصل لهذا الكود ننتفع به وننفع غيرنا رابط هذا التعليق شارك More sharing options...
سامي الحداد قام بنشر مارس 24 مشاركة قام بنشر مارس 24 4 ساعات مضت, طير البحر said: للاسف لم يؤدي الكود الوظيفة المرجوة عجيب كيف لم يؤدي الوظيفة؟ الا اذا كنت تقصد شيئا اخر ! ملاحظة برنامج Word يجب ان يكون مفلقا حتى يتم عمل الكود. انظر للفيديو المرفق Delete Empty Word Pages.rar رابط هذا التعليق شارك More sharing options...
طير البحر قام بنشر مارس 25 الكاتب مشاركة قام بنشر مارس 25 18 hours ago, سامي الحداد said: عجيب كيف لم يؤدي الوظيفة؟ الا اذا كنت تقصد شيئا اخر ! ملاحظة برنامج Word يجب ان يكون مفلقا حتى يتم عمل الكود. انظر للفيديو المرفق Delete Empty Word Pages.rar 1014.93 kB · 2 downloads اقدر اهتمام حضرتك جدا ولكن دعنا نجعل المحتوى صورة او اى شئ اخر غير النص سيقوم بحذفه فورا؟ رابط هذا التعليق شارك More sharing options...
سامي الحداد قام بنشر مارس 25 مشاركة قام بنشر مارس 25 11 ساعات مضت, طير البحر said: ولكن دعنا نجعل المحتوى صورة او اى شئ اخر غير النص سيقوم بحذفه فورا؟ أخي الكريم طلبك كان حذف الصفحات الفارغة من ملف وورد برمجيا . وهذا ما تم عمله لحذف الصفحات الفارغه ولا له علاقة بطلبك الثاني . سوف اتوقف هنا. تحياتي 1 رابط هذا التعليق شارك More sharing options...
طير البحر قام بنشر مارس 25 الكاتب مشاركة قام بنشر مارس 25 9 hours ago, سامي الحداد said: أخي الكريم طلبك كان حذف الصفحات الفارغة من ملف وورد برمجيا . وهذا ما تم عمله لحذف الصفحات الفارغه ولا له علاقة بطلبك الثاني . سوف اتوقف هنا. تحياتي اقدر مساهمتك اعظم تقدير ولكن هل الصفحات المحتوية على صور فقط تعتبر فارغة ان طلبي محدد من البداية الصفخات الفارغة اى يجب ان تكون فارغة من اى محتوى رابط هذا التعليق شارك More sharing options...
سامي الحداد قام بنشر مارس 26 مشاركة قام بنشر مارس 26 10 ساعات مضت, طير البحر said: ان طلبي محدد من البداية الصفخات الفارغة اى يجب ان تكون فارغة من اى محتوى اخي الكريم وهذا ما عملته بالضبط يجب ان تكون الصفحة خالية تماما من اي محتوى،،، والكود يقوم بهذه المهة فقط. سؤال هل فعلا جربت الكود لإني على يقين حضرتك لم تجرب الكود. وإلا لكان رأيت عمل الكود بالضبط. الاخوة الكرام من يستطيع ان يجرب الكود ويعلمني اذا كان يعمل او لا . ربما اكون مخطئ. وهذا الكود مرة اخرى Option Compare Database Option Explicit Private Sub Command0_Click() CleanUpWordDocument End Sub Public Function DeleteBlankPages(wd As Word.Document) Dim par As Paragraph For Each par In wd.Paragraphs If Len(par.Range.Text) <= 1 Then par.Range.Delete End If Next par End Function Public Sub CleanUpWordDocument() Dim wdApp As New Word.Application Dim wdDoc As Word.Document Set wdDoc = wdApp.Documents.Open("C:\Users\LENOVO\Documents\Test1.docx")' استبدل المسار DeleteBlankPages wdDoc MsgBox "تمت عملية حذف الصفحات الفارغة", vbInformation + vbMsgBoxRight, "تأكيد" wdDoc.Save wdDoc.Close wdApp.Quit Set wdDoc = Nothing Set wdApp = Nothing End Sub رابط هذا التعليق شارك More sharing options...
طير البحر قام بنشر مارس 26 الكاتب مشاركة قام بنشر مارس 26 15 hours ago, سامي الحداد said: اخي الكريم وهذا ما عملته بالضبط يجب ان تكون الصفحة خالية تماما من اي محتوى،،، والكود يقوم بهذه المهة فقط. سؤال هل فعلا جربت الكود لإني على يقين حضرتك لم تجرب الكود. وإلا لكان رأيت عمل الكود بالضبط. الاخوة الكرام من يستطيع ان يجرب الكود ويعلمني اذا كان يعمل او لا . ربما اكون مخطئ. وهذا الكود مرة اخرى Option Compare Database Option Explicit Private Sub Command0_Click() CleanUpWordDocument End Sub Public Function DeleteBlankPages(wd As Word.Document) Dim par As Paragraph For Each par In wd.Paragraphs If Len(par.Range.Text) <= 1 Then par.Range.Delete End If Next par End Function Public Sub CleanUpWordDocument() Dim wdApp As New Word.Application Dim wdDoc As Word.Document Set wdDoc = wdApp.Documents.Open("C:\Users\LENOVO\Documents\Test1.docx")' استبدل المسار DeleteBlankPages wdDoc MsgBox "تمت عملية حذف الصفحات الفارغة", vbInformation + vbMsgBoxRight, "تأكيد" wdDoc.Save wdDoc.Close wdApp.Quit Set wdDoc = Nothing Set wdApp = Nothing End Sub نعم جربته وهو يحذف الصفحات الفارغة فعلا لكن المشكلة انه يعتبر الصفحات التى تحتوي على صور فقط فارغة ايضا ويقوم بحذف الصور تفضل فقط بادراج صورة فى احد الصفحات ثم انظر لسلوك الكود لان الكود يبحث عن نص فى فقرة فاذا لم يجد نص فهو يعتبر الصفحة فارغة ويطبق امر الحذف delete وعند وجود صورة فى الصفحة فقط فهو يعتبرها فارغة وينفذ امر الحذف الذلي عندها يحذف الصورة فقط ويترك الصفخة خالية رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان