حمادة عمر

الف مليون مبروك ومن تقدم  الي تقدم ان شاء الله

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

السلام عليكم 

الاخ الكريم / S0bhy    بارك الله فيك 

الملف المرفق منك لم اتمكن من فك الضغط الخاص به 

ولكن اليك المرفق اظن به ما تريد ... شاهد المرفق واشعرنا بالنتائج 

( قم بالوقوق علي الصف الذي تريد نسخه بمعادلاته وتنسيقاته في اي خليه فيه ثم اضغط علي الزر الاحمر الموجود بالملف 

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

تقبل خالص تحياتي 

نسخ واضافة الصفوف المطلوبه بمعادلاتها وتنسيقاته.xls

السلام عليكم 

الاخ الكريم / اياد م    .. بارك الله فيك 

تقبل خالص تحياتي 

اليك نفس الملف الخاص بالقدير الصديق العزيز / يحياوي .. جزاه الله خيرا 

ولكن بتعديل بسيط ليعمل كما تريد ( اغلاق الملف فقط بعد المدة التي تحددها في بنفسك في الكود من خمول الملف ) 

واليك الملف التالي قم بتجربته واخبارنا بالنتائج 

تقبل خالص تحياتي 

غلف الملف بعد مدة من ترك ملف غير نشط.xls

بارك الله فيك 

استاذنا القدير الحبيب / مجدي يونس 

تقبل خالص تقديري واحترامي لشخصكم الكريم 

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

اخي الكريم 

استخدم هذا الامر 

Private Sub TextBox1_Change()
Range("a1").Value = TextBox1.Value
End Sub

ليكن مثلا ان قيمة التكست المطلوب مرتبطه بالخلية A1

,G;L HGA;V 

 السلام عليكم 

الاخ الكريم / علي المصري

بارك الله فيك 

تقبل خالص تحياتي 

 السلام عليكم 

الاخ الكريم / خالد حدادة

بارك الله فيك 

تقبل خالص تحياتي 

 السلام عليكم 

الاخ الكريم / mostafa sharaf

بارك الله فيك 

تقبل خالص تحياتي 

شاهد اخ الكريم الروابط التالية

وايضا هذ الرابط

ان شاء الله بهم ما تريد تماماً اخي الكريم

تقبل خالص تحياتي

تفضل المرفق اخي الكريم

فتح خانه ترحيل البيانات+.rar

برجاء ارفاق ملف كمثال اخي الكريم ليتم العمل عليه

برجاء ارفاق ملف كمثال اخي الكريم ليتم العمل عليه

قم اخي الكريم بارفاق ملف كمثال لما تريد لان كل ملف يختلف عن الآخر في متطلباته

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

ولكن كان له تقريبا نفس طلبك وتم تنفيذه بالطريقة التي حددها ( استخدم زر اضافة حساب ... وشاهد الفورم 2 )

اظن ان بهم ما تريد ... جرب الملف واخبرنا بالنتيجة

تقبل خالص تحياتي

Copy of المجد1.rar

قم اخي الكريم باستبدال الكود الموجود في هذا المودل بالكامل بالكود التالي

وان شاء الله سيعمل معك الملف .. ولم اتمكن في ضبطه بصورة نهائية لان ملفك به اكواد أخري مرتبطه بشيتات غير موجودة

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

مع اني انصحك بتغيير نظام الويندوز لديك الي 32 حيث ان مايكروسوف نفسها تنصح باستخدام الـ 32 عن استخدام الـ 64

تقبل خالص تحياتي

Public Const ENGLISH As String = "09"
Public Const ARABIC As String = "01"

#If VBA7 Then

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" ( _
    ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" ( _
    ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long

#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
 

  



Sub SwitchLayout(Lang As String)

Dim Layouts() As Long
Dim NoOfLayouts As Long
Dim i As Long


NoOfLayouts = GetKeyboardLayoutList(0, ByVal 0&)

ReDim Layouts(NoOfLayouts)

GetKeyboardLayoutList NoOfLayouts, Layouts(0)


For i = 0 To NoOfLayouts - 1
   If UCase(Lang) = UCase(Right(Hex(Layouts(i)), 2)) Then
    ActivateKeyboardLayout Layouts(i), 0
    Exit For
   End If
Next

End Sub

555555+.rar

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

تقبل خالص تحياتي

هل الويندوز الذي عندك 32 بت أو 64 بت؟

او جرب استبدال الاسطر المظللة بالاحمر في الكود خاصتك بالاسطر التالية

واشعرنا بالنتيجة

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" ( ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If

عذرا اخي الكريم لم اتمكن من الاطلاع علي ملفك .. لا اعلم ان ان السبب لدي ام لديك لاني لم ابحث الامر

وعموما :

شاهد اخي الكرم المرفق التالي

قم بالضغط بالماوس في اي خلية في الشيت دبل كليك ستظهر لك الرزنامة الخاصة بالتاريخ

اختار اليوم المطلوب ادخاله كتاريخ بالماوس وسيتم ادخاله

وهذا الامر مطبق علي الشيت 1 بالكامل مهما كانت عدد الخلايا المطلوبة ادخال التاريخ فيها

كتابة التاريخ في اي خلية.rar

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

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

تقبل خالص تحياتي

السلام عليكم

الاخ الكريم /  الشافعي

بارك الله فيك

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

في بداية الكود موجود الدالة call بالسطر

Call MC

وهذا السطر يعني اعطاء امر للكود باحضار الأمر او الكود او الماكرو المسمي لديك بـ MC ليتم تنفيذ الاوامر الخاصه به

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

وكمثال .. السطر الثاني وهو كالتالي :

ThisWorkbook.Worksheets("Step Up Feature").Range("H15").Value = ThisWorkbook.Worksheets("Step Up Feature").Range("D15").Value

فالسطر السابق يعني في الجزء الاول      ThisWorkbook.Worksheets("Step Up Feature").Range("H15").Value

انه في هذ الملف ThisWorkbook في شيت العمل Worksheets المسمي بالاسم  Step Up Feature اجعل النطاق او الخلية المحدد H15 وقيمتها  Range("H15").Value 

تســــــــــــــــــــاوي  =

والجزء الثاني من هذا السطر بالكود له نفس المعني ولكن باختلاف الشيت والخلية المحددة

اي ان هذا السطر يقصد انه اجعل الخلية H15 في الشيت Step Up Feature = الخلية D15 في الشيت المسمي  Step Up Feature

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

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

تقبل خالص تحياتي

شاهد اخي الكريم الرابط التالي

جرب اخي الكريم المرفق التالي

ان شاء الله يفي بطلبك

تقبل خالص تحياتي

Book1.rar

من الافضل ارفاق ملف كمثال لما هو مطلوب

ليمكن للجميع مساعدتك

تقبل خالص تحياتي

السلام عليكم

الاخت الفاضلة / rosealshamasad

بارك الله فيكي

واهلا وسهلاً بك بين اخوانك بالمنتدي

وان شاء الله ستسعدين بالانضمام الي اسرة هذا الصرح العملاق

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

وبعد اذنك سوف اضع الرقم السري لفتح ملفك وهو  : 123

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

تقبلي خالص تحياتي

السلام عليكم

الاخ الكريم / mostafa_27

بارك الله فيك

بعد اذن اخي الاستاذ الحبيب /  سليم حاصبيا  .. جزاه الله خيرا

وعلي حسب فهمي لطلبك وباستخدام الكود المقدم من الاستاذ / سليم .. يكون الكود بالشكل التالي

Private Sub CommandButton1_Click()
    CommandButton1.Caption = IIf(CommandButton1.Caption = "Hide", "Show", "Hide")
    If CommandButton1.Caption = "Hide" Then
    Range("H:I,K:K,N:N").EntireColumn.Hidden = True
Else
    If CommandButton1.Caption = "Show" Then
    Range("H:I,K:K,N:N").EntireColumn.Hidden = False

 End If
 End If

End Sub

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

تقبل خالص تحياتي

امرين مختلفين في زر وراحد - اظهار & اخفاء.rar

اخي الكريم / اسلام سيد

بارك الله فيك 

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