تحويل المعادلات إلى أكواد VBA

[الـعيدروس]

السلام عليكم

أخوتي الاحبه حفظكم الله

هذا طلب تكرر كثيرا من بعض الأعضاء

وهذه محاولتي

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

كمثال وتغيره مثل ماتريد

'*********************************************

' مدى المعادلات في كل الأوراق

'*********************************************

Private Const Rng As String = "$A$2:$Z$500"

وهذه الأكواد انسخها في مودويل

'*********************************************

' مدى المعادلات في كل الأوراق

'*********************************************

Private Const Rng As String = "$A$2:$Z$500"

Private Sub Ali_M()

Set V_A = ActiveWorkbook.VBProject

Set V_b = V_A.VBComponents.Add(vbext_ct_StdModule)

V_b.Name = "My_Frmola"

End Sub

Private Sub Ali_Delet()

On Error Resume Next

Dim V_A

Dim V_b

Set V_A = ActiveWorkbook.VBProject

Set V_b = V_A.VBComponents("My_Frmola")

ActiveWorkbook.VBProject.VBComponents.Remove V_b

End Sub

Public Sub Ali_Fmla_To_VBA()

Dim Sht As Worksheet

Dim R As Range, Rr As Range

Dim Ar_Ads(), Ar_Fm()

Dim F, Lc, Prmit_A, Rw

Call Ad_Refe: Call Ali_Delet: Call Ali_M

Dim A

Dim B

Dim C

Set A = ThisWorkbook.VBProject

Set C = A.VBComponents.Item("My_Frmola").CodeModule

On Error Resume Next

For Each Sht In ThisWorkbook.Worksheets

For Each Rr In Sht.Range(Rng).SpecialCells(xlCellTypeFormulas)

If Not IsEmpty(Rr) Then

ReDim Preserve Ar_Ads(0 To F)

ReDim Preserve Ar_Fm(0 To Lc)

Ar_Ads(Lc) = "Sheets(""" & Rr.Worksheet.Name & """)" & "." & "Range(""" & Rr.Address(0, 0) & """)"

Ar_Fm(F) = "=" & "Evaluate(""" & Rr.FormulaLocal & """)"

F = F + 1: Lc = Lc + 1

End If

Next

Next

With C

.AddFromString ("Sub Ali_Formola" & vbCrLf)

For Prmit_A = LBound(Ar_Ads) To UBound(Ar_Ads)

N = .CountOfLines

.InsertLines N, Ar_Ads(Prmit_A) & Ar_Fm(Prmit_A)

N = N + 1

Next

.InsertLines N + 1, vbCrLf & "End Sub"

End With

Erase Ar_Ads: Erase Ar_Fm

End Sub

Private Sub Ad_Refe()

On Error Resume Next

With ThisWorkbook.VBProject.References

  .AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL"

   .AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"

   .AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL"

  .AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"

End With

End Sub

بعد النسخ الى مودويل " Alt " + F8 تشغيل الكود المسمى " Ali_Fmla_To_VBA "

بعد استخدام الكود كما ذكرت

اذا اردت تحويل المعادلات في جميع الأوراق الى أكواد فعل الماكرو المسمى " Ali_Formola "

أرجو تجربة الكود

الكود يعتبر بدائي ولاكن يمكن تطويره فيما بعد

تحويل المعادلات الى اكواد.rar

[وليد المصرى 1]

اشكرك اخى الفاضل

انا عندى ملف بعمل علية به معادلات vlookupوبسترد بياناتة من ملف قاعدة بيانات فماذا يكون الكود

اخى عباد اسف انا مش خبير فى الاكواد لى سؤال ايضا بعد تفعيل الكود المفروض انى امسح المعادلات ويشتغل الكود صح ولا الكود له طريقة اخره

تم تعديل يناير 23, 2013 بواسطه goodlife

[الـعيدروس]

اخى عباد اسف انا مش خبير فى الاكواد لى سؤال ايضا بعد تفعيل الكود المفروض انى امسح المعادلات ويشتغل الكود صح ولا الكود له طريقة اخره

نعم اخي الفاضل

لاكن تشغيل الكود تقوم بتشغيله وليس اتوماتيك

بالامكان ربطه بحدث الورقه أو المصنف

تم تعديل يناير 23, 2013 بواسطه عباد

[الشيباني1]

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

[الـعيدروس]

اخي الشيباني1

بعد تنفيذ الكود شغل الماكرو المسمى " Ali_Formola " كم الشرح في الماشركة الاولى

بعد استخدام الكود كما ذكرت

اذا اردت تحويل المعادلات في جميع الأوراق الى أكواد فعل الماكرو المسمى " Ali_Formola "

[وليد المصرى 1]

تمام يا اخى الكود يعمل ولكن على ملفك المرفق جزاك الله خير

ولكن انا عندى ملف به معادلات كثيرة واكثرها معادلة vlookup وبتسترد بيانتة من ملف اخر قاعدة بيانات وفماذا يكون الكود هنا ؟

وهل يمكن ان يعمل الكود اتوماتيك

تم تعديل يناير 23, 2013 بواسطه goodlife

[الـعيدروس]

اخي goodlife

ولكن انا عندى ملف به معادلات كثيرة واكثرها معادلة vlookup وبتسترد بيانتة من ملف اخر قاعدة بيانات وفماذا يكون الكود هنا ؟

اضن انه سيعمل معك جرب الكود ارجو ان يزبط معك

وهل يمكن ان يعمل الكود

اتوماتيك

حط الكود التالي في حدث الـ ThisWorkbook

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

Application.DisplayAlerts = False

Application.EnableEvents = False

On Error Resume Next

Call Ali_Formola

Application.EnableEvents = True

Application.DisplayAlerts = True

End Sub

[الـعيدروس]

السلام عليكم

 

اخي goodlife

 

هل عمل معك الكود ؟

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عباد - ابونصار

الكود يعطيني خطأ في الملف المرسل بالمشاركة الاولي ولم اقم بتجربته بعد علي اي ملف لدي

ويعطيني خطأ في هذ السطر

 

Set V_A = ActiveWorkbook.VBProject
 

وفي انتظار الرد استاذي

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

[الـعيدروس]

السلام عليكم

 

اخي حماده عمر

 

جرب استبدل الكود المسمى Ad_Refe

 

بالتالي نفس الكود عليه اضافه اعتقد تحل مشكلة رسالة الخطاء

Private Sub Ad_Refe()
On Error Resume Next
With ThisWorkbook.VBProject.References
  .AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL"
   .AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
   .AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL"
   .AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
  .AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End With
End Sub

 

جرب وبلغنى بالنتائج

تحويل المعادلات الى اكواد_A.rar

تم تعديل يناير 26, 2013 بواسطه عباد

[حمادة عمر]

السلام عليكم

استاذ القدير / ابو نصار

 

نفس المشكلة لدي ونفس الخطأ الذي يظهر لدي في السطر

 

Set V_A = ActiveWorkbook.VBProject
 

وقمت بتغيير مسار الملفات المطلوبة ايضاً في الكود لتكون كما هي لدي بالجهاز الي  ( مثلا ) هذا السطر

 

"C:\Program Files\Common Files\microsoft shared\VBA\VBA6\VBE6.DLL"

 

بدلا من السطر

 

"C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL"
 

ولكن مع نفس الخطأ فهل هذا سليم ام ماذا

مع العلم استاذي القدير ان لدي اوفيس 2003 ونسخة 7

جزاك الله خيرا استاذنا القدير

[الـعيدروس]

طيب اذهب الى قائمة أدوات

ثم خيارات ثم امان ثم امان الماكرو

ثم القائمة الجانبية ناشرون موثوقون

ثم حفز الثقه بالوصول إلى مشروع Visual Basic

[اسلام سيد]

السلام عليكم استاذ عباد لقد تابعت الاكواد ونفس المشكله حدثت معى

 

وقمت باستبدال الكود كما  نصحت الاخ حمادة عمر إلا وانه حدث نفس الخطأ واعطانى خطأ  فى الكود التالى

 

Set V_A = ActiveWorkbook.VBProject

[رجب جاويش]

أخى الفاضل  المبدع / عباد

فى البداية كانت تظهر المشكلة التى أشار اليها الاخوة الأفاضل

ولكن مع تفعيل الثقه بالوصول إلى مشروع Visual Basic

تم حل المشكلة ويعمل الكود بشكل صحيح

تسلم ايديك

[رجب جاويش]

كل الشكر والتحية للمبدع عباد ( أبو نصار )

 

تم تعديل يناير 26, 2013 بواسطه رجب جاويش

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عباد

 

بعد تفعيل الثقه بالوصول إلى مشروع Visual Basic

اصبح الكود يعمل بكفاءة وبطريقة راائعة

كم انت راااائع ايها الكبير جدا

 

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

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

[محمد ع]

أخي الفاضل هل من الممكن شرح خطوات الوثوق بمشروع Visual Basic لانني لم اتمكن من ذلك

 

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

تم تعديل يناير 26, 2013 بواسطه محمد ع

[وليد المصرى 1]

للاسف اخى عباد لا يعمل

[اسلام سيد]

أخي الفاضل هل من الممكن شرح خطوات الوثوق بمشروع Visual Basic لانني لم اتمكن من ذلك

 

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

وانا ايضا اريد شرح هذة الخطوه بارك الله فيك

[الـعيدروس]

السلام عليكم

 

اخي إسلام الشيمي

اخي الفاضل محمد ع

 

تابع شرح المشاركة رقم 12

اذا كان الاوفيس الذي لديك 2007 اتبع الشرح التالي

 

اذهب الى خيارات الإكسل

ثم مركز التوثيق ثم إعدادات مركز التوثيق

ثم إعدادت الماكرو ثم إعدادت وحدات الماكرو الخاصه بالمطورين

وحفز على الثقه في الوصول إلى طراز كائن مشروع VBA

 

اخي الحبيب المتألق رجب جاويش

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

 

اخي الكريم حماده عمر

الحمد لله انه عمل معك جزاك الله خير

واعتقد يعمل مع كافة المعادلات

ولاكن أرجو منك تجربته مع معادلات الصفيف

إذا عمل أكيد بيعمل مع كل المعادلات

 

 

اخي  goodlife

هل اتبعت الشرح الذي في المشاركة رقم 12

 

ارجو التجربه بعد تفعيل ثقة مشروع VBA

تم تعديل يناير 27, 2013 بواسطه عباد

[اسلام سيد]

استاذ عباد بارك الله فيك

جارى الاطلع

تم تعديل يناير 27, 2013 بواسطه إسلام الشيمي

[اسلام سيد]

استاذ عباد جربت الكود على شيت معى واظن انه يعمل لكن المعادلات موجوده كما هى  وإذا قمت بمسحها لا يعمل

اظن انه يعمل لانه لم يصدر لى رساله خطأ

[وليد المصرى 1]

عملت يا اخى تفعيل ثقة مشروع  وللاسف مش عارف فين المشكلة لكن انا بحاول

[اسلام سيد]

عملت يا اخى تفعيل ثقة مشروع  وللاسف مش عارف فين المشكلة لكن انا بحاول

لاتنسى استبدال الجزء الاخير الذى ذكرة الاستاذ عباد

[اسلام سيد]

استاذنا هذا هو الشيت ارجو من حضرتك التجربه عليه0 البرنامج-------الموسم2000-------البرنامج.rar