اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

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

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

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

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

ملف الفورم.rar

رابط هذا التعليق
شارك

أخي الكريم سيف النصر

أهلا بك في المنتدى ونورت بين إخوانك

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

كما يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لمعرفة كيفية التعامل بشكل أفضل مع المنتدى

 

بالنسبة لطلبك إليك شرح الكود مع تعديل بسيط ليناسب طلبك كما ذكرت في تعليقات الكود

'تعريف متغير من النوع النصي
Dim MyWindow As String

Private Sub CommandButton1_Click()
    'تعريف المتغيرات
    Dim xlApp As Application, I As Integer, FilePath
    'ليعبر عن تطبيق الإكسيل [xlApp] تعيين قيمة للمتغير المسمى
    Set xlApp = Application
    'تعيين قيمة المتغير النصي ليساوي عنوان النافذة الحالية للملف
    MyWindow = xlApp.ActiveWindow.Caption
    
    'بدء التعامل مع خاصية نافذة فتح الملفات
    With xlApp.FileDialog(msoFileDialogOpen)
        'عنوان نافذة فتح الملفات
        .Title = "تحميل الملف"
        'إمكانية تحديد أكثر من ملف
        .AllowMultiSelect = True
        .Show
        
        'عمل حلقة تكرارية لكل الملفات التي تم تحديدها من قبل المستخدم
        For Each FilePath In .SelectedItems
            'زيادة المتغير بمقدار واحد مع كل حلقة تكرارية
            I = I + 1
            
            'إذا وجد مسار الملف أي أن الملف موجود يتم تنفيذ السطر التالي
            If Not FilePath = vbNullString Then
                Rx3 (FilePath)
            End If
        'الانتقال للملف التالي ضمن الملفات التي تم تحديدها
        Next FilePath
    End With
    
    'إغلاق المصنف الحالي مع حفظ التغيرات
    ThisWorkbook.Close True
    Exit Sub
Err:
    'إظهار رسالة خطأ في حالة حدوث خطأ ما
    MsgBox Err.Description, vbCritical, "Error"
End Sub

Sub Rx3(Filename As String)
    'فتح المصنف عن طريق تحديد مساره
    Workbooks.Open Filename:=Filename
    
    '[Sheet1] تحديد ورقة العمل المسماة
    Sheets("Sheet1").Select
    
    'وضع نص معين في الخلية الأولى مع جعل الخط أسود عريض
    With Range("A1")
        .Value = "YasserKhalil"
        .Font.Bold = True
    End With
    
    'إغلاق المصنف النشط مع حفظ التغييرات
    ActiveWorkbook.Close True
End Sub

أرجو أن يكون المطلوب ..

إليك الملف المرفق فيه شرح الكود مع التعديلات التي تمت

تقبل تحياتي

 

Open File Name YasserKhalil.rar

  • Like 2
رابط هذا التعليق
شارك

مشكور ما قصرت في شئ

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

قَالَ رَسُولُ اللَّهِ صَلَّى اللَّهُ عَلَيْهِ وَسَلَّمَ: "مَنْ صُنِعَ إِلَيْهِ مَعْرُوفٌ فَقَالَ لِفَاعِلِهِ: جَزَاكَ اللَّهُ خَيْرًا فَقَدْ أَبْلَغَ فِي الثَّنَاءِ".

صححه الألباني (المشكاة، 3024).

وعن طلحة بن عبيدالله بن كريز قال: قال عمر: لَوْ يَعْلَم أَحَدُكُمْ مَا لَهُ فِي قَوْلِهِ لأَخِيهِ: جَزَاكَ الله خَيْرًا، لأَكْثَرَ مِنْهَا بَعْضُكُمْ لِبَعْضٍ.

قال العلامة المباركفوري في "تحفة الأحوذي بشرح جامع الترمذي": (جَزَاك اللَّهُ خَيْرًا) أَيْ خَيْرَ الْجَزَاءِ أَوْ أَعْطَاك خَيْرًا مِنْ خَيْرَيْ الدُّنْيَا وَالْآخِرَةِ. (فَقَدْ أَبْلَغَ فِي الثَّنَاءِ) أَيْ بَالَغَ فِي أَدَاءِ شُكْرِهِ وَذَلِكَ أَنَّهُ اِعْتَرَفَ بِالتَّقْصِيرِ وَأَنَّهُ مِمَّنْ عَجَزَ عَنْ جَزَائِهِ وَثَنَائِهِ فَفَوَّضَ جَزَاءَهُ إِلَى اللَّهِ لِيَجْزِيَهُ الْجَزَاءَ الْأَوْفَى. قَالَ بَعْضُهُمْ: إِذَا قَصُرَتْ يَدَاك بِالْمُكَافَأَةِ, فَلْيَطُلْ لِسَانُك بِالشُّكْرِ وَالدُّعَاءِ .
 

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

  • Like 2
رابط هذا التعليق
شارك

أخي الكريم سيف النصر

لم تغير اسم الظهور للغة العربية (اللغة العربية .. لغتنا الجميلة)

وجزيت خير الجزاء بمثل ما دعوت

بارك الله فيك والحمد لله الذي بنعمته تتم الصالحات

تقبل وافر تقديري واحترامي

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
×
×
  • اضف...

Important Information