بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
cat101
-
Posts
443 -
تاريخ الانضمام
-
تاريخ اخر زياره
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
مشاركات المكتوبه بواسطه cat101
-
-
-
-
بارك الله فيكم فين استاذ محمد الدسوقي ليبدا الواجهات والغمل
-
بارك الله فيك استاذ سليم
-
بارك الله فيكم .. يارب يكمل الكود
-
بارك الله فيك استاذ ياسر
-
1
-
-
لانريد مواقع ربحيه سيئه
ما اسم البرنامج الموضوع ؟
-
4 ساعات مضت, cat101 said:
جزاك الله خيرا .. وبارك فيك
اخي المحترم اريد برنامج يفك الملفات المحميه الاكواد
جزاك الله خيرا .. وبارك فيك
اخي المحترم اريد برنامج يفك الملفات المحميه الاكواد
-
Private Sub Cmd_Sheet_Click() If Txt_Password.Value = "roaa" Then Application.Visible = True Unload Me Exit Sub End If MsgBox "الكلمة غير صحيحة - ادخل الكلمة مرة ثانية" Txt_Password.Value = "" Txt_Password.SetFocus End Sub Private Sub CmdClose_Click() Unload Me ActiveWorkbook.Close True End Sub Private Sub UserForm_QueryClose(cancel As Integer, closeMode As Integer) If closeMode = 0 Then cancel = True MsgBox "عذرا الخروج من زر إغلاق" End If End Subجزاك الله خيرا .. وبارك فيك
اخي المحترم اريد برنامج يفك الملفات المحميه الاكواد
-
كلمه السر للصفحات officena
اما كلمه سر الفيجوال لااعرفها رجاء فكها حتى يتم التعلم
اريد ان اسال الاستاذ رجب ... وضع هذا الغمل في المنتدى يعني لوجه الله بدون مقابل
ما الداعي لوضع كلمات السر
استحلفكم بالله كل من يريد وضع برنامجه خالصا لوجه الله لايضع اي كلمه سر وان اراد فيضع الرقم 1 ويظهر ذلك في ملف التحميل
http://www.mediafire.com/file/qocl83f8o5u2cgp/كنترول+رجب+ابتدائى+أعمال+فقط.rar
-
في ٤/٦/٢٠١٦ at 00:40, ابو عبدالبارى said:
بعد اذن الأستاذ رجب جاويش
قمت بالتعديل على الملف لحل مشكلة ترحيل ناجح وراسب بوضع زر فى صفحة الشيت للترحيل
واليكم التعديل فى هذا الملف
http://www.mediafire.com/download/4sczzx1xk1fkoyw/كنترول_الإعدادى__رجب_جاويش_الإصدار__15.rar
جزاك الله خيرا
14 ساعات مضت, cat101 said:ماهي كلمات السر للصفحات والفيجوال .. من فضلكم
من فضلكم .. حتى نتعلم
-
1
-
-
ماهي كلمات السر للصفحات والفيجوال .. من فضلكم
-
1
-
-
الاستاذ المحترم عبد الباري
جزاك الله كل خير : وبعد
مواضيعك قيمه وخاصه هذا البرنامج
لو تكرمت نرجو شرح منك لكيفيه عمل هذا البرنامج لعله يكون عند الله ثقيلا في ميزان حسناتك ...
هتبقى مجموعة دروس غايه في الروعه من استاذ فاضل
-
البرنامج يحتاج لكلمه سر واسم الدخول .... جزاك الله خيرا
-
جزاك الله خيراً
-
في ٢٢/٥/٢٠١٤ at 08:34, أم عبد الله said:
الأستاذ الفاضل / قنديل الصياد
السلام عليكم ورحمة الله وبركاته
جزاك الله خيراً على المراجعة وهذه المعلومة أعلمها جيداً ولكن تم العمل على المتقدم فعذراً لهذا الخطأ الغير مقصود وإليكم الملف مرة اخرى. لك كل التحية والتقدير.
جزاك الله خيراً
-
جعله الله فى ميزان حسناتكم
-
جزاكم الله خيرا
-
جزاك الله خيرا وبارك لك
اين جزء الدور التاني ؟
==================================
كنترول روعه فيه جهد ملحوظ جعله الله في كفة
حسناتك
-
بعض الأكواد البسيطة والمطلوبة
بعض الأكواد البسيطة التى يسأل عنها الأخوة الأعضاء ووجدتها في موقعنا الحبيب أوفسينا فجمعتها بعد إذن كاتبيها وتكون هذه دعوة لباقى الأخوة وعمالقتهم لتزويدنا بأكواد جديدة أو مشابهة .. والله الموفق
1- فتح الملف على اليوزرفورم Userform.
يمكن فتح الملف على فورم بدلا من صفحة الإكسل المعروفة بكود بسيط تجده في كثير من ملفات الأخوة بالموقع وخطوات ذلك كالتالي:
أ- أضف للملف يوزرفورم وذلك في محرر الفيجوال بيسك من قائمة إدراج(Insert) نختار (UserForm).
ب- في قسم المشروع (Project) انقر مزدوجا ThisWorkbook
ب- في نافذة الكود اكتب الكود التالي
Private Sub Workbook_Open()
UserForm1.Show
End Sub
وهذا الكود ليس به إلا سطر واحد يأمر الإكسل بفتح الملف على اليوزر فورم وهذا السطر هو
UserForm1.Show
بعد انتهاء العمل نجد أن الملف يفتح على الفورم ونجد ان الفورم يمكن تحريكه في أي اتجاه كما يمكننا أن نغلقه من مفتاح الغلق في أقصى يمين الفورم من أعلى كما نلاحظ أن ملف الإكسل يظهر وراء الفورم.
أنظر First.rar
2- فتح الملف على اليوزرفورم مع إخفاء صفحة الإكسل.
رأينا في المثال السابق ولإخفاء ملف الإكسل ضف السطر التالي للكود السابق ليصبح الكود بالصورة أن الملف يفتح على الفورم لكن ملف الإكسل يظهر وراء الفورم
Private Sub Workbook_Open()
Application.Visible = False
UserForm1.Show
End Sub
هذا السطر Application.Visible = False يجعل ملف الإكسل مخفيا
انظر المرفق Second.rar
3- فتح الفورم على مقاس الشاشة.
والأن.. ماذا نفعل لنفتح الفورم على مقاس الشاشة؟ تابع معي:
الفكرة أن نجعل أبعاد الفورم مثل أبعاد الشاشة ولكن باختلاف المستخدمين للملف سيكون هناك أبعاد مختلفة من حاسوب وآخر ولذلك يمكن عمل الكود التالي:
()Private Sub UserForm_Activate
With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With
ونجد أن الكود يطلب أن يكون اتساع الفورم كما اتساع التطبيق وارتفاع الفورم كإرتفاع التطبيق والآن جرب الكود في نافذة كود الفورم. انظر التطبيق Third.rar
ولكن قم بتحريك الفورم في كل الاتجاهات، هل يستجيب الفورم للحركة؟
4- نثبت الفورم (الفريم) بحيث لايمكن تحريكه الى اي اتجاه.
يمكن نثبت الفورم بحيث لايمكن تحريكه الى اي اتجاه وذلك بكتابة هذا الكود في نافذة كود الفورم.
Private Sub UserForm_Layout()
With Me
.Left = Application.Left
.Top = Application.Top
End With
End Sub
انظر التطبيق Forth.rar
5- الغاء رمز الاغلاق(x).
يمكن إلغاء عمل رمز الأغلاق في أفصى يمين أعلى الفورم بالكود التالي ولكن هذا أن يجعلك تستطيع إغلاق الفورم أو الإكسل ولذلك أقترح أن تضع على الفورم مفتاح تسمية "إغلاق" ويكون له كود فقم أولا بكتابة الكودين المرفقين
()Private Sub CommandButton1_Click
Unload Me
End Sub
)Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
لاحظ أن هذا الكود سيمنع إغلاف الفورم من (X) ولكن يمكن إغلاق الفورم من زر إغلاق الذي أضفناه، وإذا أردنا إغلاق الفور وملف الإكسل معا نضع السطر التالي في كود المفتاح بعد "Unload Me":
ActiveWorkbook.Close True
انظر التطبيق Fifth.rar
6- عمل شاشة افتتاحية.
يحتاج بعض مطورى البرامج لأن يبدأ عمل ملفه بظهور شاشة أفتتاحية فعلى سبيل المثال "نريد عمل صفحه تبدأ مع فتح ملف الاكسيل، ويكون بها ايقونات بمسميات الشيتات الموجوده بالملف، وعند الضغط على احد الايقونات يتم النقل الى الشيت المطلوب بعض النظر عن الشيت الذي أقفل البرنامج عليه"
فهيا معا نبنى هذا التطبيق:
أ- افتح ملف جديد ثم ضف إليه في الصفحة الأولى شكلين أكتب على الأول كلمة "الورقة الثانية" وعلى الشكل الثاني كلمة "الورقة الثانية" ثم أربط كل شكل مع ورقة العمل المناسبة لما كتب عليع وذلك ربطا تشعبيا"
ب- كرر العمل في الورقة الثانية والثالثة مع تغيير ما يلزم.
ت- أضف فورم للملف وضع عليه ثلاثة مفاتيح أكتب على الأول "الورقة الأولى" والثاني "الورقة الثانية" والثالث "الورقة الثالثة"
ث- أكتب الكود التالي في مكان كود الفورم
()Private Sub CommandButton1_Click
Unload Me
Worksheets("Sheet1").Activate
End Sub
()Private Sub CommandButton2_Click
Unload Me
Worksheets("Sheet2").Activate
End Sub
()Private Sub CommandButton3_Click
Unload Me
Worksheets("Sheet3").Activate
End Sub
ج- اكتب الكود التالي في مكان كود "ThisWorkbook":
()Private Sub WorkBook_Open
UserForm1.Show
End Sub
انظر التطبيق "شاشة أفتتاحية.rar"
إخواني الأعزاء أسمحوا لي أن أتوقف هنا
وإذا كنتم أستفدتم فسأكمل.
والله الموفق
ربنا يبارك فيك بحق الله اخي
===============================================
===========================
سر على بركة الله واكمل
-
4
-
1
-
هذه داله تفقيط كيف تاتي بالكسر مثلا 500.3
Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'Sex جنس العملة " ' FALSE ( أو فارغ او صفر مذكر ) " ' TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'NCurr_Si اسم العملة الرئيسية مفرد " 'NCurr_Pl اسم العملة الرئيسية جمع " 'NCurrDec_Si اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '========================================================" ' : للدلالة على تفقيط الكسر عين التالي " 'NCurrDec_pl اسم العملة الكسرية جمع " 'dSex جنس عملة الكسر " ' FALSE ( أو فارغ او صفر مذكر ) " ' TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ' ملاحظات ' (اولاً : العملة الرئيسية مثنى (يقوم بها الكود تلقائيا ' مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر ' اسماء العملات (الجمع والكسري) فارغة تلقائيا ' ----------------------- '("" ثالثاً : امكانية إضافة كلمة بداية ونهاية النص (فارغة Private Const MyBegTx As String = "فقط " Private Const MyEndTx As String = "" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Private Const wow As String * 2 = " و" '===============================================================================================================================================" Function kh_TextNum(Num As String, Optional Sex As Boolean = False _ , Optional NCurr_Si As String = "", Optional NCurr_Pl As String = "" _ , Optional NCurrDec_Si As String = "", Optional Decimal_Count As Byte = 0 _ , Optional NCurrDec_Pl As String = "", Optional dSex As Boolean = False) As String '====================================== Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit If Num = 0 Then Txt = MyBegTx & "صفر " & NCurr_Si: GoTo kh_Exit '====================================== Spp = Split("/" & MyTNum, "/") ii = UBound(Spp) If Num < 0 Then Num = Abs(Num) '====================================== If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit '====================================== nCurr = NCurr_Si & "-" & IIf(NCurr_Pl = "", NCurr_Si, IIf(NCurr_Si = "", "", NCurr_Pl)) '====================================== Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000") For i = 0 To ii MyMid = Mid(Txt1, (i * 3) + 1, 3) If MyMid Then zt = Mid(Txt1, (i * 3) + 4, Len(Txt1)) zt = IIf(ii - i, Int(zt), 1) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(Sex)) Txt = Txt & IIf(Len(Txt), wow, "") & kh_nText(MyMid, Txt2, pr, zt, CBool(NCurr_Si <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " " & NCurr_Si, IIf(Decimal_Count = 0, "صفر", "")) Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, NCurr_Si, Trim(NCurrDec_Si), Decimal_Count, Trim(NCurrDec_Pl), dSex) & MyEndTx '====================================== kh_Exit: kh_TextNum = Trim(Txt) End Function ' معالجة العدد من 1 الى 999 لكل فئات الرقم Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal Z As Boolean, ByVal tCu As Boolean) As String Dim Sp Dim Num1%, Num2%, Num3% Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$ '====================================== Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",") '====================================== If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة" oM = Trim(Split(oMm, "-")(0)) '====================================== Num1 = Left(iNum, 1) Num2 = Right(iNum, 2) Select Case Num1 Case 1: nT0 = "مائة" Case 2: nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن")) Case 3 To 9: nT0 = Sp(Num1) & "مائة" End Select '========================================= Num1 = Right(iNum, 2) Select Case Num1 Case 1, 2: If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM Case 11 To 99: If oM <> "" Then If ibs Then If Z Then oM = oM & "اً" End Select '----------------------------------------- Select Case Num1 Case 1 nT = IIf(oM = "", Sp(0) & S1, oM) oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "") Case 2 nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(Z = 0 And ibs = 2 And tCu, "ا", "ان")) oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "") Case 3 To 10 oM = Trim(Split(oMm, "-")(1)) nT = Sp(Num1) & S Case 11, 12 nT = Sp(Num1) & Sp(10) & S1 Case 13 To 19 nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1 Case 20 To 99 Num2 = Right(Num1, 1) Num3 = Left(Num1, 1) If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون" nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & wow & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", wow) nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية") kh_nText = Trim(nT0 & S & nT & " " & oM) '====================================== End Function ' معالجة الكسر Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte, ByVal Ndec_pl As String, ByVal dsx As Boolean) As String Dim Td$, dwow$, Td1$ On Error GoTo 1 If co = 0 Then GoTo 1 If NCur = "" Then Ndec = "" Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0")) If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1 If Int(dNum) Then dwow = wow If Len(Ndec) Then Ndec = " " & Ndec Td1 = Td * CVar("1" & String(co, "0")) If Len(Ndec_pl) And co < 4 Then Td1 = dwow & kh_nText(Format(Td1, "000"), Ndec & "-" & Ndec_pl, 1 + CInt(dsx), 1, 0): GoTo 1 Else Ndec = " " & NCur: Td1 = Td End If Td1 = dwow & " " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Functionمن فضلكم
-
الاستاذ رجب
جزاك الله كل خير
ماهو جديدك في الكنترولات .. يعني هل صممت كنترول جديد ؟
-
جزاك الله خيرا استاذ ياسر خليل
-
1
-
-
روابط لكنترولات مفيده
نسخة التعليم الإبتدائى
من الميديا فاير
نسخة التعليم الإعدادى
من الميديا فاير
نسخة التعليم الثانوى العام
من الميديافاير
نسخة التعليم الصناعى
من الميديا فير
نسخة التعليم التجارى
من الميديا فير
نسخة التعليم الفندقى
من الميديا فير
نسخة التعليم الإبتدائى للأزهر الشريف
من الميديا فير
البرنامج لا يفتح الا من خلال كلمة مرور (1) يمكن تغييرها كيفما تشاء
الانتقال من مستوى صلاحية الى اخر يتم من خلال كلمة مرور اخرى (1)
يمكن ايضا تغييرها فى أى وقت
فمثلاً يمكن تفعيل قائمة (جلوس وسرى) وقائمة (مطبوعات) باتباع الاتى :
اعدادات - تغيير الصلاحية - اختيار رئيس الكنترول - وضع كلمة المرور:1 ثم الضغط على موافق
-
1
-
تحويل الأرقام من عربي إلى هندي في وورد 2016 - MS WORD 2016
في منتدي الوورد Word
قام بنشر
بارك الله فيك