ماكرو لتحويل النص الى رقم

[محمد أبوعبدالله]

بسم الله الرحمن الرحيم

الاخوة الكرام

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

وجدت برنامج رائع جدا لتصدير جداول واستعلامات بالاكسيس الى شيت اكسيل والبرنامج اكثر من رائع فعلا وهو عىل الرايط التالي

http://www.officena.net/ib/topic/58001-منقول-هدية-برنامج-تصدير-بيانات-من-جداولاستعلامات-اكسس-الى-اكسل

المشكلة التي واجهتني انه يوجد حقول نصية بالجدول وتحتوي على ارقام وهذا لفائدة هامة لي في البرنامج المشكلة انه عند تصدير البيانات تظهر مشكلة في الاكسيل رسالة تطلب تحويل القيمة الى رقم وهذا ما احتاجه فعلا في عملية تجميع

 

 

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

ارجو ان اكون قد وضحت المشكلة بصورة جيدة

والشكر للجميع مقدما

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

[ياسر خليل أبو البراء]

أخي الكريم ارفق الملف المراد العمل عليه ..

جرب الكود التالي عله يفي بالغرض

Sub ConvertTextToNumber()
    Dim R As Range
    On Error Resume Next
    For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(R) Then R.Value = Val(R.Value)
    Next R
End Sub

 

[محمد أبوعبدالله]

جزاك الله خيرا استاذ ياسر ولو امكن كيف تنفيذ الكود بزر امر او عند فتح البرنامج تلقائيا واعذرني لان خبرتي ضعيفة في الاكسيل

مرفق الملف ولك الشكر

تحياتي

00101.rar

[ياسر خليل أبو البراء]

أخي الكريم محمد

يرجى تغيير اسم الظهور للغة العربية

إليك الملف المرفق فيه تطبيق الكود ..

 

Convert Text To Numbers YK.rar

[محمد أبوعبدالله]

جزاك الله خيرا استاذي الفاضل

هذا هو المطلوب بالضبط

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

دمت لاخيك

تحياتي

تم تعديل أكتوبر 26, 2015 بواسطه Mo7med

[ياسر خليل أبو البراء]

إليك الرابط التالي

من هنا

[ياسر خليل أبو البراء]

أخي الكريم المراغي

إليك الكود التالي ..جربته على ملفك ويعمل بشكل جيد جداً

Sub ConvertTextToNumber()
    Dim R As Range, WS As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
        For Each WS In ThisWorkbook.Sheets
            For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants)
                If IsNumeric(R) Then R.Value = Val(R.Value)
            Next R
        Next WS
    Application.ScreenUpdating = True
End Sub

 

[محمد أبوعبدالله]

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

جربت الكود ولم يقم بتحويل الحقول النصية الى رقمية

برجاء التجربة مرة اخرى ...

بانتظارك استاذ الفاضل

تحياتي

 

[محمد حسن المحمد]

في ٢٧‏/١٠‏/٢٠١٥ ١:٤٩:١٤, ياسر خليل أبو البراء said:

أخي الكريم محمد

يرجى تغيير اسم الظهور للغة العربية

إليك الملف المرفق فيه تطبيق الكود ..

 

Convert Text To Numbers YK.rar

السلام عليكم ..

جربت هذا الكود ممتاز جداً..حول الأرقام المنسقة كنص إلى أرقام عامة وتم حساب الدوال على هذا الأساس

جزاكم الله خيراً ...أخي الحبيب أبو البراء..

[Yasser Fathi Albanna]

هاتفضل طول عمرك تبهرنى بكل ما تقدمه من أعمال فى غاية الروعة أستاذى القدير / ياسر خليل

زادك الله من فضلة وعلمه

 

[ياسر خليل أبو البراء]

أخي الكريم المراغي

وضح المشكلة بشكل أكثر تفصيل ..يعني اذكر خلايا محددة لم يتم فيها التحويل .. جرب دالة الجمع مع الخلايا التي تقصدها أولاً وشوف هل يتم جمعها أم لا؟

ارفق ملفك بعد تنفيذ الكود ...

كما يرجى ذكر نسخة الاوفيس التي تعمل عليها ؟؟

 

[محمد أبوعبدالله]

جزاك الله خيرا استاذي الفاضل

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

ولك وافر التحية

[ياسر خليل أبو البراء]

لم توضح أخي الكريم المراغي المشكلة التي كانت لديك

يرجى طرحها والخطوات التي قمت بها للوصول للحل ..ليستفيد الجميع في حالة حدوث مثل تلك المشكلة

تقبل تحياتي

[محمد أبوعبدالله]

السلام عليكم

مرحبا استاذي الفاضل ياسر

المشكلة التى كانت عندي لدي عمود يقوم بغمل ترتيب حسب المجموع وفي المثال المرفق عمود Fo

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

فقمت بالغاء العمود Fo لحل المشكلة

ولو ان هناك حل افضل يكون لكم جزيل الشكر

دمتم بود

تحياتي

Convert Text To Numbers YK.rar

[ياسر خليل أبو البراء]

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

جرب وأعلمني بالنتيجة

Sub ConvertTextToNumber()
    Dim R As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        For Each R In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
            If IsNumeric(R) Then R.Value = Val(R.Value)
        Next R
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    MsgBox "Done!", 64
End Sub

تقبل تحياتي

 

[محمد أبوعبدالله]

الله يصلح حالك ويهديك الى الجنة استاذ ياسر

الكود الجديد ما شاء الله يعمل بكفاءة وسرعة

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

دمت بكل خير

تم تعديل نوفمبر 12, 2015 بواسطه المراغي

[ياسر خليل أبو البراء]

الحمد لله الذي بنعمته تتم الصالحات

وجزيت خيراً بمثل ما دعوت أخي المراغي .. وإن شاء الله ستجد المساعدة من إخوانك بالمنتدى دائماً

تقبل تحياتي