محمد حجازي

السلام عليكم ... بالنسبة لأخي المهاجر ، البرنامج موجود مع حزمة الأوفيس 2003

السلام عليكم ... أخي ، منذ شهرين و أنا أبحث في الانترنيت عن كتاب لهذا البرنامج ولكن بلاجدوى. الرجاء إذا كان لديك وصلة لكتاب عن هذا البرنامج تزويدي بها. عملية بحثي لم تخرج إلا بعدد محدود من الصفحات عن هذا البرنامج ، و الشرح فيها كان عام جداً ومقتضب لنناقش معاً وظيفة البرنامج: البرنامج سهل الاستخدام كما تفضلت ، ولكن واجهتني معه بعض المشاكل : - فيما قرأت فإن الإنفو باث يدعم بشكل كبير لغة الـ XML لدرجة تجعله يعتمد عليها في كل شيئ تقريباً ، وقد استطعت بواسطته إنشاء ملف XML وربط عناصر الـ XML بأدوات الإنفوباث (قائمة منسدلة ، مربع نص ، ... الخ) ، ولكن وللأسف لم استطع إدخال المعلومات في النموذج ، أي أريد الطريقة التي يمكن لهذا البرنامج إدخال البيانات لقاعدة البيانات المنشئة (وذلك بواسطة النموذج بالطبع). - يقال أن الإنفوباث يمكنه الربط بين برامج الأوفيس : اكسل ، وورد ، أكسس ... الخ أو بين قواعد البيانات المختلفة : أوراكل ، أكسس ، SQL ...الخ ، ورغم محاولاتي لم أستطع إجراء عملية الربط هذه . الرجاء إفادتي بتجاربكم . بمناسبة ذكر الإنفو باث فأنا أنصحكم بشدة بلغة XML فهي لغة المستقبل ، وبالفعل فقد حصلت على كتاب ورقي عن هذه اللغة وأنا الآن في مرحلة تعلمها و إن شاء الله أزودكم بملفات تمثل خلاصة تجاربي مع هذه اللغة في أقرب وقت. تحياتي

موقع الدكتور مصطفى الفقير : http://mstawfik.tripod.com/

السلام عليكم ... بالنسبة لكود النسخ ، تفضل : Private Sub Worksheet_Change(ByVal Target As range) Dim EndRow As Long If Target.Column = 4 Then If Sheets(1).Cells(Target.Row, Target.Column).Value = "ناجح" Then Sheets(1).Rows(Target.Row).Copy EndRow = Sheets(2).range("A1").CurrentRegion.Rows.Count Sheets(2).Rows(EndRow + 1).Insert Shift:=xlDown Sheets(1).Select End If End If End Sub ولكن يجب عليك الانتباه للملاحظات : - الصق الكود في الورقة الأولى - الكود يقوم بالنسخ من الورقة الأولى في الترتيب إلى الورقة الثانية في الترتيب ، ويمكنك تغيير المصدو و الوجهة بتغيير الترتيب بعد كلمة Sheets - الكود لا يعمل إلا إذا قمت أنت بالتعديل ، أي أن الكود غير صالح في حالات تعديل قيمة الخلية عن طريق دالة معينة

السلام عليكم ... الكود التالي لدالة وليس لإجراء ، لذلك قم بما يلي : - الصق الكود في الـ Model - اذهب لورقة العمل و اكتب الصيغة التالية : =sound(A1) الخلية A1 مثلاً هي الخلية التي سوف يظهر فيها التقدير (ناجح / راسب) ، وانتبه إلى أن المجال الذي يوجد بداخل الدالة هو لخلية واحدة فقط وبذلك فأنت مضطر إلى إرفاق دالة لكل خلية يجب أن تختبرها (يمكن ذلك عن طريق التعبئة). الدالة السابقة بالإضافة للصوت و الحركة ترجع قيمة True إذا كانت الخلية المختبرة تحتوي على كلمة ناجح وترجع False في عكس ذلك ، ويمكنك إخفاء العامود الذي يحتوي على الدالة مثلاًَ في حال عدم رغبتك بظهور القيمتين True ، False

السلام عليكم ... وينك أخي المهاجر ، طولت الغيبة يعطيك العافية وطل علينا بمشاركاتك الممتازة ولا تنسانا أبداً

السلام عليكم ... هذا كود يقوم بالانتقال للورقة التي تقوم بإدخال اسمها : Sub SelectSheets() Dim MySheets As Worksheet Dim SheetsName As String 1 SheetsName = Application.InputBox(prompt:="ادخل اسم الورقة المراد الانتقال إليها", Title:="اسم الورقة", Type:=2) If SheetsName = "" Or SheetsName = "False" Then Exit Sub Else For Each MySheets In ActiveWorkbook.Worksheets If MySheets.Name = SheetsName Then Sheets(SheetsName).Select Exit Sub End If Next MySheets MsgBox ("لاتوجد ورقة بهذا الاسم") GoTo 1 End If End Sub SelectSheets.zip

السلام عليكم ... جرب الدالة التالية : Function sound(MyCells As range) If MyCells.Value = "ناجح" Then With Application.Assistant .Visible = True .On = True If Not Sounds Then Sounds = True .Animation = msoAnimationCharacterSuccessMajor End With sound = True Else sound = False End If End Function ولكن انتبه إلى أن المجال الذي يوجد بداخل الدالة لا يصلح إلا لخلية واحدة فقط للأسف لم أجد الاداة Microsoft multimedia control 6.0 في محرر الـ VBA لذلك استعنت بمساعد الأوفيس لإظهار الصوت و القيام بحركة تدل على النجاح Sound.zip

السلام عليكم ... بالنسبة للكود فهو شغال عندي ، ولكن يجب الانتباه إلى الملاحظات التالية : - بالنسبة لورقة العمل ، فالرقم 1 يدل على الورقة الأولى في الترتيب وليست الورقة ذات الاسم 1 ، ولتجعل الكود يستند لقيمة الخلية A1 في الورقة Sheet1 مثلاً يجب هنا وضع اسم الورقة بين علامتي تنصيص " " مثل الكود التالي : Sub PrintPages() Worksheets("Sheet1").PrintOut From:=1, To:=Worksheets("Sheet1").Range("A1").Value, Copies:=1, Collate _ :=True End Sub - بالنسبة لطباعة الصفحات ، الكود محدود بالحد الأعلى للصفحات ، أي ما دام التقرير يستوعب صفحتين فقط فإنه سيقوم بطباعة هاتين الصفحتين حتى لو كانت قيمة الخلية A1 تساوي 10 مثلاً - بالنسبة لأسماء الصفحات ، الأول للصفحة المطبوعة و الثاني للصفحة التي تحتوي على الخلية A1 بالنسبة للكود الأول ، فأنا أسعى دائماً للتبسيط تكرم و تفضل الكود : Sub PrintPages() NumberPages = Application.InputBox(prompt:="أدخل عدد الصفحات التي تريد طباعتها", Title:="طباعة", Type:=1) If NumberPages = False Then Exit Sub Else Worksheets(1).PrintOut From:=1, To:=NumberPages, Copies:=1, Collate _ :=True End If End Sub

السلام عليكم ... نسيت أنك تريد كتابة رقم الصفحات المراد طباعتها في خلية محددة ، جرب الكود التالي : Sub PrintPages() Worksheets(1).PrintOut From:=1, To:=Worksheets(1).Range("A1").Value, Copies:=1, Collate _ :=True End Sub مع مراعات كتابة عدد الصفحات في الخلية A1 بالتوفيق

السلام عليكم ... جرب الكود التالي : Sub PrintPages() NumberPages = InputBox("أدخل عدد الصفحات التي تريد طباعتها", "طباعة") Worksheets(1).PrintOut From:=1, To:=NumberPages, Copies:=1, Collate _ :=True End Sub

السلام عليكم ... أحياناً قد نحتاج للقيام بعملية EnterChange بين خليتين (الخليتين B3 و D3 مثلاً) ، فهل فكرت بعمل مثل هذا الشيء بواسطة كود الـ VBA ؟!! هذه العملية شائعة الاستخدام بين المبرمجين تحت اسم Swap وذلك للقيام بعملية التبديل بين المتغيرات. للقيام بهذه العملية فأنت بحاجة لتعريف متغير يقوم بمهمة الوسيط في عملية التبديل ، المتغير TempValue في الكود التالي: Sub SwapCells1() Dim TempValue With Worksheets(1) TempValue = .Range("B3").Value .Range("B3").Value = .Range("D3").Value .Range("D3").Value = TempValue End With End Sub لاحظ أن المتغير TempValue ينتمي لنوع البيانات Variant ، وذلك لأن الخلايا المتقايضة يمكن أن تحتوي على : نص ، أرقام ، تاريخ ، ... الخ ولكن إذا كنا نعلم بشكل مسبق أن الخليتين B3 ، D3 لن تحتويان إلا على أرقام ، فهنا يمكننا الاستغناء عن المتغير TempValue ، وذلك بواسطة إحدى الطرق الموجودة في الأكواد التالية : Sub SwapCells2() With Worksheets(1) .Range("B3").Value = .Range("B3").Value + .Range("D3").Value .Range("D3").Value = .Range("B3").Value - .Range("D3").Value .Range("B3").Value = .Range("B3").Value - .Range("D3").Value End With End Sub Sub SwapCells3() With Worksheets(1) .Range("B3").Value = .Range("B3").Value * .Range("D3").Value .Range("D3").Value = .Range("B3").Value / .Range("D3").Value .Range("B3").Value = .Range("B3").Value / .Range("D3").Value End With End Sub Sub SwapCells4() With Worksheets(1) .Range("B3").Value = .Range("B3").Value Xor .Range("D3").Value .Range("D3").Value = .Range("D3").Value Xor .Range("B3").Value .Range("B3").Value = .Range("B3").Value Xor .Range("D3").Value End With End Sub إن الاستغناء عن المتغير TempValue يوفر علينا حجز مساحة في ذاكرة الحاسب و بالتالي فإن الطرق السابقة تحد من استهلاك مساحة إضافية من الذاكرة لا طائل منها ، و الطرق السابقة تعتمد على جعل قيمة إحدى الخليتين دالة في قيمتي الخليتين. يمكن أن نقول بأن الطريقة الموجودة في الإجراء SwapCells4 هي الأفضل على الإطلاق :pp: منقول بتصرف من الرابط التالي: http://www.c4arab.com/showthread.php?threadid=28624 Swap.zip

السلام عليكم ... - مجال التصفية : عرفتها لوحدك ، مثال A1:AJ10 - ترتيب العامود المراد تصفيته (حقل التصفية) : هو الحقل الذي تتم التصفية انطلاقاً منه ، مثال عندما تختار الرقم 3 يقو م الاكسل بالتصفية اعتماداً على العامود C - القيمة التي تريد تصفيتها : مثال عندما تختار كلمة ناجح فإن الاكسل يعرض جميع السجلات التي تحتوي في حقلها الثالث (العامود C) على كلمة ناجح راجع الرابط التالي: http://www.officena.net/ib/index.php?showtopic=4555

السلام عليكم ... عيدكم مبارك ... وإن شاء الله نلتقي في العيد القادم على جبل عرفات

السلام عليكم ... التعليمة InputBox تستعمل لإدخال بيانات من خلال فورم جاهز ، وفي المثال السابق قمنا بإسناد البيانات المدخلة إلى المتغيرات ومن ثم ربط المتغيرات بأسلوب AutoFilter ، أي أن المتغيرات هنا هي صلة الوصل بين الأسلوب AutoFilter و فورم إدخال البيانات InputBox للتعليمة InputBox عدد من البرامترات يمكنك الإطلاع عليها من خلال نظام المساعدة الموجود في محرر الفيجوال ، و أول برامترين هما بالترتيب : عنوان الفورم ، نص الرسالة الموجودة على الفورم ويمكنك الاستعاضة عن التعليمة InputBox بإنشاء فورم بشكل يدوي ووضع أدارة النص TextBox فيه

السلام عليكم ... يمكنك ذلك عن طريق تخزين معلومات الخلايا المعدلة في مصفوفة ، و البحث عند كل عملية تعديل عما إذا كانت الخلية المناظرة للخلية المعدلة قد تم تعديلها سابقاً استبدل الكود الموجود في الورقة الأولى بالتالي : Dim ChangeCells(2) As Long Private Sub Worksheet_Change(ByVal Target As Range) Dim TargetR_C(2) As Long TargetR_C(1) = Target.Row TargetR_C(2) = Target.Column If TargetR_C(2) = 6 Or TargetR_C(2) = 7 Then If ChangeCells(2) = TargetR_C(2) Then GoTo 1 Else Select Case ChangeCells(1) Case 0 GoTo 1 Case TargetR_C(1) Sheets(1).Rows(TargetR_C(1)).Cut EndRow = Sheets(2).Range("A1").CurrentRegion.Rows.Count Sheets(2).Rows(EndRow + 1).Insert Shift:=xlDown Sheets(1).Rows(TargetR_C(1)).Delete Shift:=xlUp Sheets(1).Range("A2").Select ChangeCells(1) = 0 ChangeCells(2) = 0 Case Else 1 ChangeCells(1) = TargetR_C(1) ChangeCells(2) = TargetR_C(2) End Select End If End If ويجب الانتباه إلى أن الكود غير فعال إلا إذا كان التعديل في الخليتين بشكل متتالي ، أي أنه إذا قمت بتعديل الخلية F2 ومن ثم F3 ومن ثم G2 فإن الكود لن يقوم بنقل السطر الثاني إلى الورقة الثانية DataMove.zip

السلام عليكم ... راجع الرابط التالي : http://www.c4arab.com/showthread.php?threadid=30560

السلام عليكم ... أخي ، بارك الله فيك و اسمحلي بأن أنقل مشاركتك لقسم الاكسس العام

السلام عليكم ... الملف يعمل عندي بشكل جيد يمكن أن تكون المشكلة في أن وحدات الماكرو عندك معطلة ، ولتفعيلها اتبع الخطوات التالية : حدد مستوى الأمان منخفض Low من علامة التبويب مستوى التأمين Security Level في مربع الحوار تأمين Security (القائمة أدوات Tools، القائمة الفرعية ماكرو Macro)

السلام عليكم ... المرفق : Tarhel.zip

السلام عليكم ... كود التصفية : Sub OnFilter() InputRange = InputBox("أدخل مجال التصفية", "تصفية") NemberCoulmn = InputBox("أدخل ترتيب العامود المراد تصفيته", "تصفية") ValueFilter = InputBox("أدخل القيمة التي تريد تصفيتها", "تصفية") Range(InputRange).AutoFilter Field:=NemberCoulmn, Criteria1:=ValueFilter End Sub كود إلغاء التصفية : Sub OffFilter() If ActiveSheet.AutoFilterMode Then ActiveSheet.Range("A1").AutoFilter End If End Sub

السلام عليكم ... هذا البرنامج يقوم بحساب تكلفة الاتصال بالانترنيت لجدول موجود على صفحة html (وذلك طبعاً بعد تصدير هذا الجدول إلى الاكسل) افتح صفحة الانترنيت وانقر كليك يمين على الجدول و اختر Export to Microsoft Excel ليتم تصدير الجدول إلى الاكسل قم بنسخ الجدول ( ماعدا الترويسة الموجودة في الرأس و المجموع الإجمالي الموجود في الذيل) وألصقه في ملف البرنامج تابع التعليمات الموجودة في الملف بالتوفيق account.zip

السلام عليكم ... كما عودتنا أخي حسام ... متميز (y) بالنسبة لتطوير البرنامج : أقترح الارتقاء بالبرنامج من مدون للعمليات المالية إلى أداة مساعدة في التحليل المالي (مثلاً: كأن يقوم البرنامج بحساب القيم الحالة للقروض ، وحساب مجموع الفوائد المستحقة بالاعتماد على أصل القرض ، ومساعدتك في اختيار معدل الخصم "الفائدة" المناسب بالاعتماد على بيانات القرض و السوق) تحياتي

السلام عليكم ... جرب الكود التالي : Sub m() NumberCoulmn = 2 Set myRange = Worksheets("Sheet1").Columns(NumberCoulmn) Do Until Application.WorksheetFunction.CountA(myRange) = 0 NumberCoulmn = NumberCoulmn + 1 Set myRange = Worksheets("Sheet1").Columns(NumberCoulmn) Loop Application.ScreenUpdating = False Worksheets("Sheet1").Columns(1).Copy Worksheets("Sheet1").Columns(NumberCoulmn).Select ActiveSheet.Paste Worksheets("Sheet1").Range("A1").Select Application.ScreenUpdating = True End Sub

السلام عليكم ... ضع الكود التالي في الورقة الأولى : Private Sub Worksheet_Change(ByVal Target As Range) Dim TargetR_C(2) As Long TargetR_C(1) = Target.Row TargetR_C(2) = Target.Column If TargetR_C(2) = 6 Or TargetR_C(2) = 7 Then Sheets(1).Rows(TargetR_C(1)).Cut EndRow = Sheets(2).Range("A1").CurrentRegion.Rows.Count Sheets(2).Rows(EndRow + 1).Insert Shift:=xlDown Sheets(1).Rows(TargetR_C(1)).Delete Shift:=xlUp Sheets(1).Range("A2").Select End If End Sub