تغيير كلمات بدون فتح الملف

[ياسر فاروق]

الساده الافاضل

السلام عليكم ورحمة الله وبركاته

هل يوجد  معادلة أو كود  تغيير عدة كلمات  بخلايا متنوعة  بعدة شيتات  بأكثر من ملف  دون فتح الملفات

وعند ارسال الملف لشخص أخر لا تتغير الجمل التى تبدلت

 

ولكم الشكر

[محمد طاهر عرفه]

هذا الكود يمثل جزء مما طلبت و ليس كله

فبتشغيله تقوم بتحديد الكلمة المراد استبدالها ، ثم الكلمة البديلة ، ثم تحدد المجلد

فيقوم الكود بفتح الملف و استبدال الكلمة و الاغلاق لكل الملفات الموجودة فى المجلد على التوالي

Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
        For Each wsh In wbk.Worksheets
            wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                LookAt:=xlWhole, MatchCase:=False
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

المصدر

الملف للتجربة

Replacer.zip

[ياسر فاروق]

أ/ محمد طاهر

السلام عليكم ورحمة الله وبركاته

أولاَ: أشكرك جدا على تفاعلك ومجهودكم الذى أتابعه على أوفيسنا ، وأود أن أستزيد من علمك

الكود المرفق يحل مسائل كثيرة ووقت ومجهود وتقليل الخطأ

وهذه الجملة (هذا الكود يمثل جزء مما طلبت و ليس كله) تؤكد أن لديك أكثر من هذا ولذلك أود أن أرفق جدول من عملى

وأيضا يوجد صورة مما اعاق العمل بالكود لحين إزالة الحماية

هل من الممكن أن نزيد إمكانية الكود كالأتى:

1- إضافة إظهار صندوق اختيار (اختيار القسم الذى يتم فيه التعديل على الملفات المختلفة فى المجلد) بخلاف ما يتم عامة

2- فى التغييرات يتم الاخذ من أول قسم 1 (Div.01) وإذ لم يوجد يكمل فى باقى الشيتات بعدها وكما ظهر لسيادتكم فى الملف المرفق ما حدث للشيت الـ Cover فى الخلية A1

3- يعمل على الملفات بدون النظر الملف به حماية أو لا

4- لا يتم الدخول على المجلد الذى به الملفات (لان المجلدات بها مجلدات أخرى - لانها شجرة - من المجلدات ولكنها خاصة بمشروع واحد) وإنما يتم الدخول على المجلد الرئيسى

5- يحول الملف إلى صيغة PDF

انا مبتدء وبحاول أفهم تعلم هذه اللغة ولكن من متابعتى لحضرتك وبعض الخيراء بالموقع يجعلنى أشعر أن كل شىء متاح لملف الاكسيل

ولكم كل الشكر والتقدير

 

Desktop.rar

[محمد طاهر عرفه]

السلام عليكم

1- إضافة إظهار صندوق اختيار (اختيار القسم الذى يتم فيه التعديل على الملفات المختلفة فى المجلد) بخلاف ما يتم عامة : الكود الحالي يقوم بالاستبدال لكل اوراق العمل ، اذا اردت اظهار رسالة لاختبار اسم ورقة العمل ، فسيعمل الكود على ورقة عمل واحدة فقط بدلا من الجميع في الوضع الحالي

2- فى التغييرات يتم الاخذ من أول قسم 1 (Div.01) وإذ لم يوجد يكمل فى باقى الشيتات بعدها وكما ظهر لسيادتكم فى الملف المرفق ما حدث للشيت الـ Cover فى الخلية A1 : اذا اردت اسثناء ورقة عمل او اكثر اسمها محدد مسبقا فهذا ممكن

3- يعمل على الملفات بدون النظر الملف به حماية أو لا : لا اعتقد ان هذا ممكن

4- لا يتم الدخول على المجلد الذى به الملفات (لان المجلدات بها مجلدات أخرى - لانها شجرة - من المجلدات ولكنها خاصة بمشروع واحد) وإنما يتم الدخول على المجلد الرئيسى : أتصور أن هذا ممكن

5- يحول الملف إلى صيغة PDF : يحوله لا اعتقد ، و لكن أتصور من الممكن حفظه بهذا التنسيق كملف اضافي

 

و ليس معني تصوري ان هذا ممكن اني اعرف الحل ،و لكن ساحاول باذن الله ، و فى انتظار مساهمة باقي الاخوة وأتوقع مساهمات و حلول  و أفكار مميزة 

[ياسر فاروق]

أ/ محمد طاهر.... السلام عليكم

أدام الله عليك نعمة المعاملة الحسنة والمساعده لوجهه الكريم

ولى سؤال إضافى بعد إذنك

هل يعمل الكود على رأس وتذييل الصفحة؟ وإذ لم، هل من الممكن؟

1- إضافة إظهار صندوق اختيار (اختيار القسم الذى يتم فيه التعديل على الملفات المختلفة فى المجلد) بخلاف ما يتم عامة : الكود الحالي يقوم بالاستبدال لكل اوراق العمل ، اذا اردت اظهار رسالة لاختبار اسم ورقة العمل ، فسيعمل الكود على ورقة عمل واحدة فقط بدلا من الجميع في الوضع الحالي - (المقصود هو ان يكون هناك إضافة صندوق اختيار أخر لذلك وإذ لم يكن فلا بأس)

2- فى التغييرات يتم الاخذ من أول قسم 1 (Div.01) وإذ لم يوجد يكمل فى باقى الشيتات بعدها وكما ظهر لسيادتكم فى الملف المرفق ما حدث للشيت الـ Cover فى الخلية A1 : اذا اردت اسثناء ورقة عمل او اكثر اسمها محدد مسبقا فهذا ممكن (من الممكن جعلها بالرقم - بدون تسمية- ويتم التحكم به فى الكود -مثل اترك (1) - من ناحية الكتابة الانجليزية - لست اعلم الامكانية)

3- يعمل على الملفات بدون النظر الملف به حماية أو لا : لا اعتقد ان هذا ممكن

4- لا يتم الدخول على المجلد الذى به الملفات (لان المجلدات بها مجلدات أخرى - لانها شجرة - من المجلدات ولكنها خاصة بمشروع واحد) وإنما يتم الدخول على المجلد الرئيسى : أتصور أن هذا ممكن (شكرا على هذا جدا)

5- يحول الملف إلى صيغة PDF : يحوله لا اعتقد ، و لكن أتصور من الممكن حفظه بهذا التنسيق كملف اضافي (هل يوجد كود يحول إلى صيغة PDF منفصل ولكن بنفس المنطق أنى أشير إلى المجلد)

و ليس معني تصوري ان هذا ممكن اني اعرف الحل ،و لكن ساحاول باذن الله ، و فى انتظار مساهمة باقي الاخوة وأتوقع مساهمات و حلول  و أفكار مميزة ( أنتظر سيادتكم والاخوة الافاضل )

 

[محمد طاهر عرفه]

 

السلام عليكم

تم عمل الاتي :

1- اضافة البحث و الاستبدال فى الرأس و التذييل Header & Footer ، مع ملاحظة ان ذلك ابطأ الملف الي حد ما ، فانتظر حتى تظهر رسالة الاستكمال و بها اسم المنتدى.

2- تم اضافة تصدير كل اوراق العمل الي ملفات  PDF مستقلة باسم الملف وورقة العمل

 يمكن التحكم فى العديد من خصائص التصدير ، مثل وضع كلمة سر مثلا بحسب التفاصيل هنا

الكود بعد التعديل

Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim ShFile As String '  short file name without extension
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
   
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    
    Application.ScreenUpdating = False
    'Application.AlertBeforeOverwriting = False
    
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
     
        
        For Each wsh In wbk.Worksheets
            
               'replace in sheets
          
                 wsh.Cells.Replace strFind, strReplace, xlPart, xlByColumns, False
                
                
                ' replace in header
                wsh.PageSetup.CenterHeader = Application.WorksheetFunction.Substitute( _
                            wsh.PageSetup.CenterHeader, strFind, strReplace)
                 wsh.PageSetup.LeftHeader = Application.WorksheetFunction.Substitute( _
                            wsh.PageSetup.LeftHeader, strFind, strReplace)
                wsh.PageSetup.RightHeader = Application.WorksheetFunction.Substitute( _
                            wsh.PageSetup.RightHeader, strFind, strReplace)
                 
                 ' replace in footer
                wsh.PageSetup.CenterFooter = Application.WorksheetFunction.Substitute( _
                            wsh.PageSetup.CenterFooter, strFind, strReplace)
                 wsh.PageSetup.LeftFooter = Application.WorksheetFunction.Substitute( _
                            wsh.PageSetup.LeftFooter, strFind, strReplace)
                wsh.PageSetup.RightFooter = Application.WorksheetFunction.Substitute( _
                            wsh.PageSetup.RightFooter, strFind, strReplace)
                wbk.Save
                ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) & Sheetcounter & "-" & wsh.Name
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
                
            
        Next wsh
        
      
        wbk.Close SaveChanges:=True
        
        strFile = Dir
        
    Loop
    Application.ScreenUpdating = True
    'Application.AlertBeforeOverwriting = True
MsgBox "تم استكمال التصدير، مع تحيات" & Chr(10) & Chr(13) & "www.officena.net"

End Sub

مرفق الملف

Replacer - 4 --.rar

[ياسر فاروق]

أ/ محمد طاهر

السلام عليكم ورحمة الله وبركاته

لا يسعنى غير قول بارك الله فى صحتك

وأود مراجعة ما تم مع سيادتكم

1- هل يعمل الكود على رأس وتذييل الصفحة؟ وإذ لم، هل من الممكن؟

تم العمل والحمد الله

 

2- فى التغييرات يتم الاخذ من أول قسم 1 (Div.01) وإذ لم يوجد يكمل فى باقى الشيتات بعدها وكما ظهر لسيادتكم فى الملف المرفق ما حدث للشيت الـ Cover فى الخلية A1 : اذا اردت اسثناء ورقة عمل او اكثر اسمها محدد مسبقا فهذا ممكن (من الممكن جعلها بالرقم - بدون تسمية- ويتم التحكم به فى الكود -مثل اترك (1) - من ناحية الكتابة الانجليزية - لست اعلم الامكانية)

 

3- لا يتم الدخول على المجلد الذى به الملفات (لان المجلدات بها مجلدات أخرى - لانها شجرة - من المجلدات ولكنها خاصة بمشروع واحد) وإنما يتم الدخول على المجلد الرئيسى : أتصور أن هذا ممكن (شكرا على هذا جدا)

متبقى هذه النقطة.

 

4- يحول الملف إلى صيغة PDF : يحوله لا اعتقد ، و لكن أتصور من الممكن حفظه بهذا التنسيق كملف اضافي (هل يوجد كود يحول إلى صيغة PDF منفصل ولكن بنفس المنطق أنى أشير إلى المجلد)

تم عمل هذه النقطة ولكن يأخذ أول شيت وهو الغلاف ويضع عليه أسم الشيت من الخارج فقط ، ولم يتم تحويل الملف بالكامل الى PDF (بمعنى أنه عندى 3 ملفات اكسيل فى المجلد - حسب ما أرفق من قبل - وعندما تم تحويل أصبح عندى تقريبا 15 ملف PDF ولكنهم عبارة عن الغلاف فقط  وعليه أسم الشيت من الخارج فقط)

وبعد إذبك - إذ كان فى الامكان - أن يكون هناك صندوق يبلغنى بعمل PDF أم لا  ، لن طبيعة عملى هى التغيير المستمر على حسب المخططات ما تتغير وإذا كان الهذا الكود بعيد عن كود التغيير

 

5- يمكن التحكم فى العديد من خصائص التصدير ، مثل وضع كلمة سر مثلا بحسب التفاصيل هنا  (نحن فى العمل غير مصرح لنا بالدخول على اى موقع سوى التعليمى فقط وبالتصريح)

 

أرجو المعذرة فيما أثقله عليك ولكن حبك للعلم وطريقة مساعدتك تجبرنى أن أستزيد

وتقبل تحياتى لسيادتكم وأنتظركم

 

[محمد طاهر عرفه]

السلام عليكم

عذا لم انتبه لردك

مبدأيا لتصدير كافة اوراق العمل و ليس الاولي فقط

الكود بالفعل يحتاج سطر اضافي

و هو السطر الثاني التالي هنا ، و اضفه بعد السطر الاول الموضح و باذن الله يتم حفظ كافة اوراق العمل دون تكرار

For Each wsh In wbk.Worksheets
           wsh.Activate
     

 

بالنسبة لاختيار تصدير ال pdf ام لا يمكن عمل ذلك عن طريق نموذج او رسالة تجيب عليها بنعم او لا

و يمكنك عمل نسخة من الكود للاستبدال فقط دون تصدير الpdf

وذلك بحذف الحزء التالي 

ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) & Sheetcounter & "-" & wsh.Name
                
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
                

 او تفعيل رسالة للسؤال هل تريد الطباعة ام لا كما يلي كابسط الطرق

اولا عرف المتغير PrintOrnot مع تعريفات المتغيرات فى بداية الكود

ثم السؤال هل تريد الطباعة ام لا

    Dim PrintOrnot As String
          
    ' to choose print pdf or not
    PrintOrnot = UCase(InputBox("Print PDFs ??? ", "Do you want to print ?", "yes"))

ثم اضف شرط قبل الطباعة بناء على قيمة المتغير السابق

و ستم الطباعة فقط فى حال الاجابة على السؤال السابق ب yes

                If PrintOrnot = "YES" Then
                              
                    ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) & Sheetcounter & "-" & wsh.Name
                    
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile _
                    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                    :=False, OpenAfterPublish:=False
                
                End If

مرفق الملف بعد التعديل

Replacer -5.xlsm

[ياسر فاروق]

أ/محمد طاهر

السلام عليكم ورحمة الله وبركاته

أشكرك جزيلا على ما تقدمه من شرح ومعلومات

هذه النقطة لازالت عالقة وهى:

- لا يتم الدخول على المجلد الذى به الملفات (لان المجلدات بها مجلدات أخرى - لانها شجرة - من المجلدات ولكنها خاصة بمشروع واحد) وإنما يتم الدخول على المجلد الرئيسى : أتصور أن هذا ممكن (شكرا على هذا جدا)

- التصدير إلى الـ PDF ( يتم التصدير إلى الـ PDF  شيت شيت - هل من الممكن جعل الملف عند التصدير إلى الـ PDF يجعله ملف واحد)

وشكرا

 

[محمد طاهر عرفه]

السلام عليكم

 

النقطة الاولي ممكنة و لكن تحتاج لبعض الوقت للتجارب ،  و ساحاول فيها بعد عدة ايام باذن الله ، و الثانية ايضا ممكنة

و باذن الله احاول اضافتهما الي المثال قريبا 

[ياسر فاروق]

أ/طاهر

فى انتظاركم الكريم

[محمد طاهر عرفه]

السلام عليكم

لاستبدال تصدير اوراق العمل كلها ، بتصدير ملف واحد الي pdf

استبدل السطرين التالليين

                    ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) & Sheetcounter & "-" & wsh.Name
                 
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile _
                    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                    :=False, OpenAfterPublish:=False

بما يلي

 ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4)

                    wbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile

و من الأفضل أن  يتم نقله خارج اللوب الخاص بالشيتات. حتى لا يتكرر إنشاء و استبدال الملف.

متبقي التعامل مع الملفات الموجودة فى المجلدات الفرعية

و ربما بعد الانتهاء نضيف واجهة استخدام باذن الله ليصبح التطبيق اكثر سهولة و اعم فى الاستخدام

[ياسر فاروق]

أ/محمد طاهر

شكرا على ما تبذله لمساعدتى وتعليمى

[ياسر فاروق]

أ/محمد طاهر

السلام عليكم ورحمة الله وبركاته

نظرا لمشاغلك، أذكرك بموضوعى

متبقي التعامل مع الملفات الموجودة فى المجلدات الفرعية

و ربما بعد الانتهاء نضيف واجهة استخدام باذن الله ليصبح التطبيق اكثر سهولة و اعم فى الاستخدام