حذف ماكرو

[خالد الشاعر]

السادة الخبراء

 

هل ممكن عمل ماكرو عند تغيير اسم الملف 

 

يحذف ماكرو معين فى نفس الملف

 

ولكم جزيل الشكر

 

جزاكم الله كل خير

[الـعيدروس]

السلام عليكم

 

انسخ الكود في مودويل

' اسم الملف الإفتراضي المراد
Private Const إسم_الملف_الإفتراضي As String = "Ali_x.xls"
' مسمى المودويل المدرج فيه الماكرو
Private Const المودويل As String = "Module1"
' الماكرو المراد حذفه اذا تغير مسمى الملف الإفتراضي
Private Const مسمى_الماكرو As String = "dd"
Sub auto_open()
    On Error Resume Next
    If ThisWorkbook.Name <> إسم_الملف_الإفتراضي Then
    Set V_C = ActiveWorkbook.VBProject.VBComponents(المودويل).CodeModule
    If Err.Number <> 0 Then
        MsgBox ("المودويل : " & المودويل & vbCr & "غير موجود في الملف الحالي")
        Exit Sub
    End If
    S_l = V_C.ProcStartLine(مسمى_الماكرو, vbext_pk_Proc)
    If Err.Number <> 0 Then
        MsgBox ("الماكرو  " & "Sub " & مسمى_الماكرو & "( )" & vbCr _
               & المودويل & "  : غير موجود في.")
    Else
    MsgBox "بسبب تغير اسم الملف" & مسمى_الماكرو & "تم حذف ماكرو", vbInformation, ""
    End If
        With V_C
            Num_l = .ProcCountLines(مسمى_الماكرو, vbext_pk_Proc)
            .DeleteLines StartLine:=S_l, Count:=Num_l
        End With
    Else
    End If
End Sub

تم تعديل أغسطس 22, 2013 بواسطه عباد

[خالد الشاعر]

استاذ عباد

 

الف شكر على هذا الرد ولكن الماكرو يعطى رسالة

 

بان "Module1" غير موجود و هو موجود فى الملف

 

فما هذا الرسالة

 

جزاك الله كل خير

تم تعديل أغسطس 23, 2013 بواسطه خالد الشاعر

[الـعيدروس]

هل غيرت الثوابت التاليه

اسم الملف "Ali_x"  و الامتداد للملف الذي تعمل عليه "xls" او "xlsm" 

غير في الثابت حسب ملفك

' اسم الملف الإفتراضي المراد
Private Const إسم_الملف_الإفتراضي As String = "Ali_x.xls"

ومكان الماكرو في اي مودويل

"Module1"  او  "Module2"

Private Const المودويل As String = "Module1"

[خالد الشاعر]

استاذ عباد

 

تم فعلاً تغير اسم الملف و يعطى ان  "Module1" غير موجود و هو موجود فى الملف

 

فما هى المشكلة

 

جزاك الله كل شكر

[الـعيدروس]

ارفق الملف

وسيتم تطبيق الكود عليه

او نسخه منه فارغه

لكي اعرف امتداد الملف والتسمية 

[خالد الشاعر]

استاذ عباد

 

مرفق ملف به ماكرو اذا تغير اسم الملف يغلق الملف

 

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

 

و جزاكم الله كل خير

اعدادي.rar

[الـعيدروس]

الكود كالتالي

' اسم الملف الإفتراضي المراد
Private Const إسم_الملف_الإفتراضي As String = "اعدادي.xls"
' مسمى المودويل المدرج فيه الماكرو
Private Const المودويل As String = "Module1"
' الماكرو المراد حذفه اذا تغير مسمى الملف الإفتراضي
Private Const مسمى_الماكرو As String = "Name2"
Sub auto_open()
    On Error Resume Next
    If ThisWorkbook.Name <> إسم_الملف_الإفتراضي Then
    Set V_C = ActiveWorkbook.VBProject.VBComponents(المودويل).CodeModule
    If Err.Number <> 0 Then
        MsgBox ("المودويل : " & المودويل & vbCr & "غير موجود في الملف الحالي")
        Exit Sub
    End If
    S_l = V_C.ProcStartLine(مسمى_الماكرو, vbext_pk_Proc)
    If Err.Number <> 0 Then
        MsgBox ("الماكرو  " & "Sub " & مسمى_الماكرو & "( )" & vbCr _
               & المودويل & "  : غير موجود في.")
    Else
    MsgBox "بسبب تغير اسم الملف" & مسمى_الماكرو & "تم حذف ماكرو", vbInformation, ""
    End If
        With V_C
            Num_l = .ProcCountLines(مسمى_الماكرو, vbext_pk_Proc)
            .DeleteLines StartLine:=S_l, Count:=Num_l
        End With
    Else
    End If
End Sub

عند تغير مسمى الملف اول وفتح الملف اول تجربه سيحذف الماكرو

وعند فتح الملف مره اخرى سيظهر لك رسالة ان الماكرو غير موجود

كذا تم الحذف وبالاماكن بعدها الاستغناء عن رسائل التنبيه

 

عموما انا غيرت لك اسم الملف في المرفق من اعدادي الى اعدادي1

وعملت لك نسخه من الكود في Module2

جرب المرفق وابلغنى بالنتائج

 

اعدادي1.rar

[خالد الشاعر]

استاذ عباد

 

الف شكر على سرعة التعاون فى الملف

 

ولكن نفس المشكلة كموجودة يعطينى نفس الرسالة ان ماكرو 1 غير موجود وهو موجود

 

هل يوجد مشكلة فى نسخة الاكسل

 

جزاك الله كل خير