بحث مخصص فى أوفيسنا

Leaderboard


Popular Content

Showing most liked content since 21 ديس, 2016 in all areas

  1. بسم الله نبدأ عامنا الحالي بهذه الموسوعة 1200_Visual_Basic_macro_examples.rar عسى أن ينال إعجابكم
    11 likes
  2. وأخيراً تمت مشاركة ملف الإكسيل في شبكة محلية مع الموظفين وتم تبادل البيانات معهم والتعديل عليها.. تابعونا لمعرفة الخطوات.
    10 likes
  3. السلام عليكم و رحمة الله تعالى و بركاته أخوتي الكرام حياكم الله. من المعروف أنه حين نجعل النموذج في وضعية ملأ الشاشة يزداد حجم النموذج و تبقى العناصر بنفس حجمها السابق مما يجعل شكل النموذج غير لائق نوعا ما. و نستطيع أن نتجاوز هذه المشكلة باستعمال الطريقة التالي: نقوم بإنشاء وحدة نمطية جديدة و نلصق بها الكود التالي: Function salah(frm As Form) Dim x, y, x1, y1 As Integer Dim moyH, moyW As Double Dim obj As Control Dim str As String x = frm.InsideHeight 'ارتفاع النموذج قبل التكبير y = frm.InsideWidth ' عرض النموذج قبل التكبير DoCmd.Maximize x1 = frm.InsideHeight 'ارتفاع النموذج بعد التكبير y1 = frm.InsideWidth ' عرض النموذج بعد التكبير moyH = x1 / x 'معامل الإرتفاع moyW = y1 / y ' معامل العرض For Each obj In frm.Controls With obj .Left = .Left * moyW .Top = .Top * moyH .Width = .Width * moyW .Height = .Height * moyH .FontSize = .FontSize * moyW End With Next End Function و أيضا أضف هذا الكود في حدث عند التحميل للنموذج: salah Me و لا تنسى أن تغير خاصية النموذج منبثق إلى نعم هذه الطريقة سوف تقوم بتكبير النموذج إلى وضعية ملأ الشاشة و تقوم بتكبير عناصر النموذج لملاءمة الوضعية الجديدة لنموذج. و الله هو الموفق. تكبير العناصر مع ملأ الشاشة لنموذج.rar
    10 likes
  4. Option Compare Text Dim tw As MSComctlLib.TreeView Dim Tbl, TMP As Variant, n Private Sub UserForm_Initialize() Tbl = Range("A3:E" & [A65000].End(xlUp).Row).Value pere = Tbl(1, 1) Set tw = Me.MonArbre n = UBound(Tbl) tw.Nodes.Add(, , "NoeudMat" & pere, Tbl(1, 1)).Expanded = True ' Racine arbre Fils pere, 1 Call icon_caption End Sub Sub Fils(parent, niv) ' procédure récursive For I = 2 To n CD = Tbl(I, 2) If CD = parent Then tw.Nodes.Add("NoeudMat" & parent, tvwChild, "NoeudMat" & Tbl(I, 1), Tbl(I, 1)).Expanded = True Fils Tbl(I, 1), niv + 1 End If Next I End Sub Private Sub MonArbre_NodeClick(ByVal Node As MSComctlLib.Node) If Left(Node.Key, 8) = "NoeudMat" Then Me.TX1 = Application.VLookup(Mid(Node.Key, 9), Tbl, 1, False) Me.TX2 = Application.VLookup(Mid(Node.Key, 9), Tbl, 2, False) Me.TX3 = Application.VLookup(Mid(Node.Key, 9), Tbl, 3, False) Me.TX4 = Application.VLookup(Mid(Node.Key, 9), Tbl, 4, False) TMP = Application.VLookup(Mid(Node.Key, 9), Tbl, 5, False) If TMP <> "" Then Me.Image1.Picture = LoadPicture("C:\ASNAF\" & TMP & ".jpg") Else Me.Image1.Picture = LoadPicture End If End If End Sub Sub icon_caption() 'Full path of the picture (UNC works too) uFile = "C:\ASNAF\ABOU SOHAIB.ico" ' Check if the picture file really exists, if not -> termine the sub ' Be careful if you have code behind this (maybe goto) X = Len(Dir(uFile)) If X = 0 Then Exit Sub 'Extract icon from picture file, and put it in the TitleBar X = ExtractIconA(0, uFile, 0) SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, X End Sub لاحقا سأبعث الملف...أنا في مرحلة الانتهاء...... تحياتي اليكم الرابط من مركز الخليج http://www.mrkzgulf.com/do.php?id=498308 http://www.up-00.com/?ggvR بعد تفكيك الملف يجب تغير مسار الملف ASNAF الى "C:\ASNAF" حتى يشتغل الملف بشكل صحيح محمد ابو صهيب
    5 likes
  5. تفضل يا سيدي: Private Sub cmdScan_Click() Dim Ret As Long, PictureFile As String PictureFile = mypathofdb() & "\PIC\" & "pic" & Me.ImageID & ".jpg" 'Ret = TWAIN_AcquireToFilename(Me.hwnd, PictureFile) Ret = TransferWithoutUI(300, RGB, 0, 0, 8.3, 11.7, PictureFile) If Ret = 0 Then Me.ImagePath = PictureFile Me![ImageFrame].Picture = Me![ImagePath] Else MsgBox "فشلت عملية المسح الضوئي", vbCritical, "تحذير" End If End Sub Private Sub cmdSelect_Click() 'TWAIN_SelectImageSource (Me.hwnd) PopupSelectSourceDialog End Sub . جعفر za-EMP.zip
    4 likes
  6. السلام عليكم اخي الكريم طرق الحل كثيرة منها ضع المعادلة التالية بالخلية D2 ثم اسحبها لاسفل =IFERROR(INDEX($A$2:$A$20,MATCH(0,INDEX(COUNTIF($D$1:D1,$A$2:$A$20),0,0),0)),"") والمعادلة التالية بالخلية E2 ثم اسحبها لاسفل =IF($D2="","",COUNTIF($A$2:$A$20,$D2))
    4 likes
  7. و هذا هو شكل البرنامج بعد إضافة بعض الأوامر للنماذج الفرعية تأثيرات النماذج.rar
    4 likes
  8. وعليكم السلام Shared ، هذه خاصية تم ادخالها في الاكسس 2010 ، والتي يعمل الاكسس جدول خاص للصور ، ثم يحفظ الصورة/الصور في الجدول ، فهذا معناه ان هذه الطريقة في واقع الامر مدمجة Embedded ، ولكن ، الميزة انك تستطيع استعمال نفس الصورة مرارا في النماذج والتقارير بينما اذا رجعنا الى طريقة ربط الصور Linked ، فبعدما تربط الصورة ، كالتالي ، مثلا: اسم الحقل: img اسم النموذج: frm_Main ربط الصورة يكون هكذا ، مثلا: Me.img.Picture = application.currentproject.path & "\Images\myPic.jpg" . واذا اردت استعمال نفس الصورة في نموذج/تقرير ثاني/ثالث ، فيمكنك استعمال الكود التالي: Me.img2.Picture = Forms!frm_Main.img.picturedata والذي لن يأخذ الصورة من القرص الصلب ، وانما سيأخذ نسخة من الصورة التي في الحقل img في النموذج frm_Main ، وسيكون اسرع من استدعاء الصورة من القرص الصلب ، ويمكنك استعمال هذا الكود في جميع اصدارات اكسس جعفر
    4 likes
  9. انظر داخل الكود في المثال ستجد السطر المسؤول عن تخصيص الملفات المعروضة strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls") لا حظ انه حدد نوع الملفات عدل عليه كما تريد ، انظر السطر هذا اضفت اليه قواعد بيانات اكسس AddFilterItem(strFilter, "Excel and access Files (*.xls), *.xls, *.mdb") او تدري عن شي احسن من كل هذا : افتح اي شيء انظر السطر strFilter = ahtAddFilterItem(strFilter, "any Files (*.*)")
    4 likes
  10. السلام عليكم و رحمة الله تعالى وبركاته أساتذة و خبراء منتدانا الغالي حياكم الله أردت أن أنجز عمل بمعيتكم الكريمة . و هو إنجاز سلسلة دروس في vba الأكسس لتقوم إدارة المنتدى من بعد ذلك بتثبيت هذا الموضوع ليطلع عليه كل من يريد التعلم و يبقى صدقة جارية لكل من ساهم فيه و لو بحرف واحد. العمل سوف يقسم إلى مجموعة دروس مثلا : المتغيرات ,الجمل الإختيارية , الجمل التكرارية , الكائنات ......الخ. و سوف نحاول شرح جميع دوال و تعليمات VBA أكسس الموجودة مع إعطاء أمثلة في نهاية كل درس. على أن يتم تجميعه في الأخير مرتبا حسب تسلسل الدروس و لا يتم الإنتقال من درس لآخر حتى نستوفي كل ما نستطيع حول هذا الدرس. العمل المطلوب: كلما نبدأ في درس جديد. يقوم الأساتذة الكرام بتقديم الدوال و التعليمات التي تندرج تحت عنوان هذا الدرس و تقديم شرحها مع وضع مثال بسيط لإستعمال الدالة أو التعليمة على أن لا يتم تكرار الدوال و التعليمات الموجودة مسبقا في الدرس من قبل أحد الأعضاء. و قبل البدء أنتظر إقتراحاتكم فيما يخص طريقة العمل أو ترتيب دروس و عناوينها. و إن شاء الله غدا أو بعد غد سوف نبدأ بالعمل على بركة الله.
    3 likes
  11. وتوضيحا لكود أخوي أبوخليل: ولمعرفة الرقم البرمجي (ascii) للزر f10 ، اطلب من الكود ان يخبرك بالرقم ، هكذا: Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) msgbox KeyCode 'If KeyCode = 27 Then ' DoCmd.Close 'End If End Sub فعندما تضغط على الزر f10 ، سترى نافذة فيها الرقم ، ولما تعرف الرقم ، استيدله بالرقم 27 (الذي في كود اخوي ابوخليل) ، وافعل ما تشاء جعفر
    3 likes
  12. وانا حاجز ثالث فقرة وجاهز في الاعمال الادارية ، تعديل ، ضم ، ترتيب ، وحتى الحذف واذا في مكتبتي شيء موافق سأعرضه
    3 likes
  13. السلام عليكم ضع هذا السطر في موديول جديد Public Abu_AhmedPrnt As Boolean ثم في حدث ThisWorkbook ضع هذا الاسطر Private Sub Workbook_BeforePrint(Cancel As Boolean) If Abu_AhmedPrnt Then Exit Sub MsgBox "لا يمكنك الطباعة بهذه الطريقة - أضغط زر الطباعة للطباعة" Cancel = True End Sub في زر الأمر الخاص بالطباعة ضع هذا السطور Abu_AhmedPrnt = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Abu_AhmedPrnt = False
    3 likes
  14. السلام عليكم هذا هو السطر المقصود .Range("A2:S2").AutoFilter Field:=4, Criteria1:=">=" & myDate1, Operator:=xlOr, Criteria2:="<=" & myDate2 تم تغير الجزء xlOr الى xlAnd
    3 likes
  15. بارك الله فيك أخي الكريم الزباري اسمح لي بمشاركة بسيطة بالموضوع .. طالما أن كود الاستدعاء يمكن أن يستخدم أكثر من مرة فالأفضل وضعه في إجراء يمكن الاستدعاء منه ..اطلع على الكود وستعرف مقصدي Sub ImportAhmad() ReadString "ahmad", Sheet2 End Sub Sub ImportAli() ReadString "ali", Sheet3 End Sub Sub ImportYosuf() ReadString "yosuf", Sheet4 End Sub Sub ReadString(customer As String, sh As Worksheet) Dim sLine As String Dim sFName As String Dim intFNumber As Integer Dim lRow As Long Dim lColumn As Long Dim vDataValues As Variant Dim intCount As Integer sFName = ThisWorkbook.Path & "\Info\" & customer & ".txt" intFNumber = FreeFile On Error Resume Next Open sFName For Input As #intFNumber If Err.Number <> 0 Then MsgBox "Text File Not Found!", vbCritical, "Error!" Exit Sub End If On Error GoTo 0 sh.Cells.Clear lRow = 1 Do While Not EOF(intFNumber) Line Input #intFNumber, sLine vDataValues = Split(sLine, vbTab) With sh lColumn = 1 For intCount = LBound(vDataValues) To UBound(vDataValues) .Cells(lRow, lColumn) = vDataValues(intCount) lColumn = lColumn + 1 Next intCount .Cells.EntireColumn.AutoFit .Activate .Range("A1").Select End With lRow = lRow + 1 Loop Close #intFNumber MsgBox "Values From File '" & sFName & "' Were Imported To Sheet '" & sh.Name & "'!", vbInformation End Sub
    3 likes
  16. السلام عليكم أخى الفاضل استخدم هذه المعادلة =IFERROR(INDEX(J2:J9;MATCH(1;(E3=G2:G9)*(A6=H2:H9)*(B6=I2:I9);0));"")
    3 likes
  17. وعليكم السلام قم بإدراج موديول جديد وضع الدالة المعرفة التالية فيه Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String With CreateObject("VBScript.RegExp") .Pattern = IIf(numOnly = True, "\D+", "-?\d+(\.\d+)?") .Global = True AlphaNum = .Replace(txt, "") End With End Function ثم في حدث الفورم ضع الكود التالي Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox3.Value = AlphaNum(TextBox1.Value, 0) TextBox2.Value = AlphaNum(TextBox1.Value, 1) End Sub
    3 likes
  18. تفضلي 1. عملنا نموذج فيه التاريخ من/الى ، 2. عملنا استعلام مجموعي ، لحساب عدد الغياب فقط بين التاريخين ، والموظف الذي يملك عدد غياب اكبر من يومين ، يتم ارسال اسمه الى الوحدة النمطية Check_Abs . تقوم الوحدة النمطية بمقارنة اليوم rst!Date ، باليوم السابق + يوم (DateAdd("d", 1, Prev_Date)، واذا كانت النتيجة متساوية ، يقوم العداد Seq بجمع الايام ، Function Check_Abs(EN) 'EN = Employee Name Dim rst As DAO.Recordset fD = [Forms]![frm_Days]![Date_From] eD = [Forms]![frm_Days]![Date_To] myCriteria = "[Emp_Name]='" & EN & "'" myCriteria = myCriteria & " And [Leave_Type]='غياب'" myCriteria = myCriteria & " And [Date] Between " & DateFormat(fD) & " And " & DateFormat(eD) 'Set rst = CurrentDb.OpenRecordset("Select * From Enterans_Absent Where [Emp_Name]='" & EN & "' And [Leave_Type]='غياب' And [Date] Between '" & DateFormat(fD) & "' And '" & DateFormat(eD) & "'") Set rst = CurrentDb.OpenRecordset("Select * From Enterans_Absent Where " & myCriteria & " Order by [Date]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount Seq = 1 Prev_Date = rst![Date] For i = 1 To RC If rst![Date] = DateAdd("d", 1, Prev_Date) Then Seq = Seq + 1 End If Prev_Date = rst![Date] rst.MoveNext Next i If Seq >= 3 Then Check_Abs = Seq & " ايام متتالية" Else Check_Abs = RC & " ايام غير متتالية" End If rst.Close: Set rst = Nothing End Function . والنتيجة: . جعفر 527.مثال 5.accdb.zip
    3 likes
  19. وكما لاحظنا بأن أخونا ابراهيم وقع في مأزق كبير أجبره على تغيير نمط تفكيره في مشاركة الملفات، وبعد التشاور مع بعض زملائه المختصين في التقنية توصل بأن يُرجع كل ملف إلى صاحبه وأن يجعل مجلد المشاركة خالياً من ملفات الإكسيل، ويقوم بفكرة ذكية هي أخذ نسخة من ملفات المندوبين إلى المجلد ويقوم هو بالتعامل مع النسخ في التقارير، يعني إيه؟ وما هي الملفات اللي راح ننسخها داخل المجلد غير ملف الإكسيل؟ في الحقيقة لا ينبغي قراءة الإكسيل من ملف إكسيل مماثل ، بل يفضل استخدام الصيغ البسيطة التي تكون ضمن ملفات نظام الكمبيوتر مثل txt.* أو csv.* وغيرها من الصيغ الأساسية. بمعنى أن تكون هيكلة الملفات كالتالي: ملفات بصيغة txt أو صيغة csv ؟!!!! وكيف أٌنشئها؟ وكيف أتعامل معها عن طريق الإكسيل؟ وهل ستنجح الفكرة؟ كل هذا سنجيب عليها لاحقاً بمثال عملي.. فقط تابعونا
    3 likes
  20. بعد اذن اخوتي الكرام بما ان المرفق mdb فتفضل ما يناسبه هذه العبارة الصقها في التنسيق الشرطي للتطبيق على الارقام الزوجية [num] MOD 2 = 0 وهذه للارقام الفردية [num] MOD 2 = 1 وهذا المرفق تم التطبيق على خلية واحدة Prog20.rar
    3 likes
  21. جرب هذا الماكرو Sub formula_to_Vba() Dim Lr As Integer Lr = Sheets("سجل مبيعات نقد").Cells(Rows.Count, 2).End(3).Row Sheets("سجل مبيعات نقد").Range("j5:j" & Lr).ClearContents Sheets("سجل مبيعات نقد").Range("j5").Formula = "=IF(AND(B5>=$M$5,B5<=$M$6),'سجل مبيعات نقد'!C5,"""")" Range("j5").AutoFill Destination:=Range("j5:j" & Lr) Range("j5:j" & Lr).Value = Range("j5:j" & Lr).Value End Sub
    3 likes
  22. الفكرة الثانية: ظن ابراهيم بأنه لو أنشأ ملف إكسيل يقوم فيه بعملية تجميع ملفات المندوبين بالمعادلات هي الطريقة السليمة تجنبه فتح ملفات المندوبين كالتالي: ومن هنا يضمن ابراهيم تحديث الملف حين فتحه بما لا يتعارض مع المندوبين، فيا ترى هل ما قام به يعتبر صحيح، وما هي المشاكل التي سيتعرض لها، تابعوووونا.
    3 likes
  23. لو تقصد إن رقم آخر صف مش هيكون الإجمالي ممكن تعتمد على أمر آخر وهو قيمة الخلية في آخر صف (أعتقد إن فيه تسلسل من 1 إلى 410 مثلاً) .. فلو كان رقم آخر صف 400 مثلاً : حاجة من الاتنين يا إما تزود 10 على رقم آخر صف عشان توصل لإجمالي الطلاب بالشكل دا For i = 1 To sh.Cells(Rows.Count, 2).End(xlUp).Row + 10 Step 2 يا إما تجيب قيمة الخلية في آخر صف بالشكل دا For i = 1 To sh.cells(sh.Cells(Rows.Count, 2).End(xlUp).Row,1).value Step 2 أو طريقة تالتة إنك تستخدم دالة Countif في محرر الأكواد عشان تعد عدد الطلاب .. كل السبل تؤدي إلى روما ..
    3 likes
  24. وجزيت خيراً بمثل ما دعوت لي أخي الكريم ناصر حددت العدد في الكود لوجود بيانات أسفل البيانات الأخرى عموماً إذا كنت تريد أن يكون مرتبط بآخر صف به بيانات في عمود محدد وليكن العمود الأول استبدل الرقم 140 بالسطر التالي Cells(rows.count,1).end(xlup).row حيث يقوم هذا الجزء بجلب رقم آخر صف به بيانات في العمود الأول .. إذا أردت عمود آخر قم باستبدال الرقم 1 في السطر السابق برقم العمود المطلوب .. أما إذا كنت تريد ربط المتغير بقيمة خلية في ورقة عمل أخرى .. اتبع التالي بفرض أن لديك في الورقة المسماة "Sheet1" في الخلية G5 القيمة المطلوبة ولتكن 410 سيتم الإشارة إلى ورقة العمل يليها الإشارة للخلية المطلوبة بهذا الشكل Sheets("Sheet1").Range("G5").Value ويستخدم هذا الجزء في هذه الحالة بدلاً من الرقم 410 في الكود
    3 likes
  25. تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة تم ارفاق كود الحل من الفاضل _ ا / ابو اسامة العينبوسي Private Sub Worksheet_SelectionChange(ByVal Target As Range) Sheets(1).Protect Password:="Secret", UserInterfaceOnly:=True Sheets(1).Cells.Locked = True If Sheets(1).Cells(ActiveCell.Row, ActiveCell.Column).Value = vbNullString Then Sheets(1).Cells(ActiveCell.Row, ActiveCell.Column).Locked = False End Sub مرفق الملف Lock.zip و لا تنسونا من صالح الدعاء تحياتى
    3 likes
  26. الأخ الكريم الأستاذ / محمد الدسوقى جرب الملف التالى لعلة يفى بالغرض abo_abary_ترحيل ناجح وراسب.rar
    3 likes
  27. السلام عليكم و رحمة الله تعالى و بركاته. أخي الأستاذ محمد أيمن بعد إذنك أريد المشاركة معكم في هذا الموضوع: يمكن أيضا تنفيذ البحث عن ملف داخل الجهاز بهذا الكود: If Dir("D:\1.txt") = "" Then MsgBox "عذرا ملف الحماية غير موجود", vbCritical Quit End If
    3 likes
  28. السلام عليكم ورحمة الله من منا لا يعرف DLookUp والتي تعني "اعلى نظرة" وبالتالي يرجع لنا اعلى نتيجة.. بس.. ليش ماتكون DLookAll "نظرة شاملة" وترجع لنا جميع النتائج مرة واحدة؟ لا قلق، نزل المرفق DLookAll.rar
    3 likes
  29. اتفضل استاذي ابو الخليل الحبيب اصدار 2003 مع تحياتي DLookAll.rar
    3 likes
  30. السلام عليكم ورحمة الله تفضل المعادلة في الملف المرفق... بن علية Demo222.rar
    3 likes
  31. حيا الله اخوي شفان للعلم ، وهذا الكود كذلك يعتمد على الامر Not الشئ الذي يجب ان يكون على بالنا وقت المشاركة في اي من المواضيع: هذا المنتدى للتعلّم وتعليم الاخرين ، لذلك ، بعض الاوقات ترى اني اضع اكثر من طريقة لحل الموضوع ، وبعض الاوقات اضع توضيح لكل سطر ، وبعض الاوقات افكك الحل لأسطر اكثر حتى يكون سهل على الشباب تغييره لاحقا ، وبعض الاوقات تحذير عن الوقوع في خطأ ومثل ما هو مكتوب في اسفل مواضيعي: في اعتقادي ، مشاركة أكثر من شخص في الرد على السؤال ، هو فائدة للجميع ، فمنه نتعلم الطرق الاخرى للإجابة على السؤال ، ونتعلم خبايا البرمجة فبمشاركة الاخ صالح ، اصبح هذا الموضوع اكثر اثراءً جعفر
    3 likes
  32. التعديل جميل ايش رايك نقلل الكود الذي وضعته انت ، بواسطة الامر Not ، ومعناه ، غيّر القيمة الحالية الى القيمة التي ليست فيه: Dim f As Boolean Dim rst As DAO.Recordset Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount f = rst!done For i = 1 To RC rst.Edit rst!done = Not f rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing End Sub . جعفر ونعم كنت على علم بهذا ، ولكني كنت اعتقد بأن المبرمج كان سيقفل على المستخدمين تغيير الحقل يدويا ، وبالتالي تكون المشكلة تم حلها ولكن ، وحتى بالحليين (الحل الثاني الذي تركته انا في الكود الاصلي) ، وحتى الطريقة التي تفضلت بها انت ، فنحن نعتمد على قيمة اول حقل ، وربما لم يكون صحيحا ، لذا سيضطر المستخدم الى الضغط على زر التغيير مرتين (بعض الاوقات للحصول على القيمة الصحيحة) جعفر
    3 likes
  33. حياك الله اخوي محمد ، واتشرف بمشاركتك واصبح لدى اخونا محمد اكثر من حل ، وذلك في السنة التالية لسؤاله جعفر
    3 likes
  34. استعمل هذا الكود: Dim curPath As String curPath = CurrentProject.Path & "\الأرشيف" If Len(Dir(curPath, vbDirectory)) = 0 Then MkDir (curPath) Else MsgBox "الملف موجود مسبقا" End If التعليمة dir تقوم بالتأكد من وجود المجلد في المسار المحدد من عدمه
    3 likes
  35. إليكم هذه الفكرة .. أرجو أن تعمل بشكل صحيح.. التنسيق في هذا المثال يتأثر باصدار ووندز وليس الأوفس. CERTIFICATE.zip
    3 likes
  36. السلام عليكم ورحمة الله وبركاته أحبتي أساتذتي الكرام الذين لطالما تعلمت منهم واستأنست بهم.. أحببت مشاركة إخوتي الكرام بمنتدانا الكريم بعمل بسيط أرجو الله تعالى أن ينفع به وأن يكون خالصاً في سبيله .. لقد اطلعت على فيديوهات تتعلق بالتركيز على الـ vba للتخفيف من حجم الملف بالمعادلات ... ولا أدري إن كانت ستحقق هذه الفائدة في الملفات كبيرة الحجم هذه الدالة التي أضفتها تعتمد على (عملية ضرب الكمية بالسعر بشرط )متعلق بعمود مساعد كما هو مبين بالمرفق أدناه. Function QtyUnitPrice(NoPlank As String, Qty As String, UnitPrice As String) 'احتساب الثمن باستخدام دالة ضمنvba If NoPlank <> "" Then NoPlank = NoPlank QtyUnitPrice = Qty * UnitPrice Else QtyUnitPrice = "" End If End Function لكنني أحببت تعريب مسمياتها محبة بلغتي ورجاء أن تدخل عالم البرمجة ذات يوم...كما يلي: Function احتساب_الثمن(دون_فراغ As String, الكمية As String, سعر_الوحدة As String) 'احتساب الثمن باستخدام دالة ضمنvba يتم تعريب التسميات If دون_فراغ <> "" Then دون_فراغ = دون_فراغ احتساب_الثمن = الكمية * سعر_الوحدة Else احتساب_الثمن = "" End If End Function يمكنكم التعديل عليها وإضافة الشروط التي ترغبونها لتوافق ملفاتكم ....أرجو توجيهي في حال وجود أي خطأ فيها كوني مبتدئ بهذا المجال والسلام عليكم ورحمة الله وبركاته. فاتورة مبيع محمد.rar كما أرجو أن تكون هناك جدولة للدوال التي يقوم السادة الأعضاء الكرام بإرفاقها لنستفيد منها أو ليستفيد أبناؤنا الأحبة منها.
    3 likes
  37. شكراً لتفاعلكم البناء.. نفس الفكرة كانت تراودني منذ فترة طويلة، وجربت طرق عديدة لكن لم أتوصل إلى أي نتيجة بسبب التعامل مع الماكرو الذي يعتبره الكمبيوتر على أنه فايروس، وكذلك عدم المقدرة على فتح الملف بأكثر من شخص، لذا لابد من التفكير بطريقة بدائية لتقسيم الملف ومن ثم إعادة تجميعه.. وقد قمنا في هذا المثال من تجميع بيانات من ملفات نصية (txt.*) وقراءتها باستخدام قائمة تجميعية، وكذلك تم توحيد مكان قراءة الملفات النصية حتى يمكن قراءتها لجميع المستخدمين دون أن يؤثر ذلك على مسار الملف المصدر (الإكسيل)، بمعنى أنه لو أنه تم نقل ملف الإكسيل إلى سطح الإكسيل مثلاً فإنه يتم قراءة الملفات النصية من مصدرها في الشبكة دون أن يفقد ارتباطها. وقبل أن ننقل الملفات إلى الشبكة سنجربها أولاً محلياً ، ومن ثم سنخبركم بما هو التغيير الذي يجب أن نفعله عندما ننقلها إلى الشبكة.. إليكم المرفقات، وقبل أن تبدأ انقل ملف الإكسيل مع المجلد إلى نفس المكان وليكن سطح المكتب مثلاً. my_sharing_files.rar أتمنى أن يشتغل معكم الملف كالتالي:
    3 likes
  38. وعليكم السلام أخي سلمان ، مجتاج معلومات اكثر منك والاهم شوية امثلة من برنامجك ، وخصوصا طريقة الدخول ، وما المعلومات التي تريد ادخالها ، والمعلومات التي تريد استردادها ، ولكن ، هناك امكانية لعمل هذا بوجه عام في معظم المواقع ، ويجب ان نجرب على هذا الموقع بالذات جعفر
    3 likes
  39. اتفضل كما تريد تقريب الى اعلى.rar
    3 likes
  40. السلام عليكم اليكم الطريقة كاملة نقوم بانشاء ملفات مثلا كتالي نفتح ملف الاكسل ولنفرض المشتريات ونقوم بعمل الفورم المطلوب للعمل نكر العملية لجميع الملفات المطلوبة نحفظ الملف ونقوم بتفح قاعد ةالبيانات واتبع الصورة / يجب ان يكون هناك جدول واحد على الاقل في القاعدة ليقبل الخيار الاخير كرر العملية نفسها لجميع الملفات اصبح لدينا الان ثلاث جداول اكسل داخل قاعدة البيانات افتح تصميم استعلام واتبع الصورة يجب ان تقوم باضافة جميع الخانات الى الاستعلام لكل جدول استعلام خاص به اخيرا قم باختيار طريقة عرض SQL وانتبه الى جميع الاضافات ان تكون موجودة ثم احفظ كرر العملية نفسها ليصبح لديك 3 استعلامات افتح ملف الاكسل باسم مدير واتبع الصورة حدد الاستعلام المطلوب واتبع الصور تم استيراد البيانات بنجاح الان قم بفتح ملف المشتريات مثلا واكتب به ثم احفظ اذهب الى صفحة المدير واختر بيانات وتحديث الكل وشاهد النتيجة مبروك عليك انتهى الشرح الان فكر بعمق كيف تستطيع ربط جمع الصفخات او المستخدمين ببرنامجك حسب ماتريد انت وشكرا تحميل الصور والملفات والشرح http://www.up-00.com/?rIXR ايضا تستطيع رفع قاعدة البيانات على الشيربونت او موقع مشاركة للعمل على الشبكة او الانترنت مثلا انت في مصر والموظف في السعودية والمراقب في سوريا يستطيعون العمل معا على قاعدة واحدة عبر الشير بونت او موقع مشاركة وشكرا
    3 likes
  41. أخي الغالي جلال الجمال لا تحزن ..إن فرج الله قريب .. وما علينا إلا أن نزرع أما الحصاد فبالتأكيد له أوانه .. افعل ما يجب عليك فعله فلربما يأتي اليوم الذي يحتاج إليه أناس آخرون ما نقدمه .. فيتركوا لنا دعوة بظهر الغيب .. وما أجملها من دعوة من شخص لا تعرفه في زمان لا تعرفه في وقت وأجل لا تعرفه ، ومن يدري لعلها تخفف عنا أخي الحبيب أبو حنين وجزيت خيراً بمثل ما دعوت لي ولك بمثل إن شاء الله .. والحمد لله أن نال الشرح إعجابكم ، وإن كان الشرح لا يجدي مع الأكواد التي تتعامل بالمصفوفات إذ أنه يجب الشرح بشكل مباشر دون الكتابة ، ولكن حاولت أن أضع الخطوط العريضة ليتمكن الأخوة من تعلم التعامل مع المصفوفات تقبلوا وافر تقديري واحترامي
    3 likes
  42. السلام عليكم ورحمة الله وبركاته كنت بصدد عمل برنامج " دليل هاتف " فصادفتني بعض المشاكل باستخدام القوائم فأردت عمل شئ من التغيير في استعمال القوائم حتى هداني الله الى فكرة بأستخدام الاكواد والحمد لله انجزتها ولكنها تبقى في بدايتها وامكانية تطويرها واردة واحببت ان اشارككم بها لعل اجد من ارائكم بعض الامور التي قد تفيد بهذا الشأن هنا ملف يحتوي على صفحة من البرنامج مع احتوائه على القائمة المذكورة اخوكم عماد الحسامي
    3 likes
  43. جرب هذا الماكرو Sub copy_All() Application.ScreenUpdating = False Dim My_sh As Worksheet Dim My_range As Range Dim k, m, lr, i As Integer k = Sheets.Count m = 3 Set My_sh = Sheets(k) My_sh.Range("a3:m1000").ClearContents For i = 2 To k - 1 With Sheets(i) lr = .Cells(Rows.Count, 1).End(3).Row Set My_range = .Range("a6:k" & lr) End With With My_sh .Cells(m, 1) = Sheets(i).Cells(1, 2) .Cells(m, 2) = Sheets(i).Cells(2, 2) My_range.Copy .Range("c" & m).PasteSpecial xlPasteValues m = m + lr - 4 End With Next My_sh.Activate Range("a3").Select Application.ScreenUpdating = True End Sub
    2 likes
  44. السلام عليكم استعمل الكود التالي: Me.txt1 = Abs(Me.txt2) abs هي دالة القيمة المطلقة يعني راح تعطيك النتيجة دائما موجبة بالتوفيق
    2 likes
  45. وعليكم السلام أخي صالح بالفعل فكرة جديدة ، وخارج عن المتعارف بس لو تسمح لي اقترح التالي: اعمل الحقول يدويا في التقرير ،وضبط المسافات ، واعطها ارقام مسلسله ، وعلى اساس العدد المطلوب ، اجعل بقية الحقول مخفية جعفر
    2 likes
  46. قم بالإشارة للصفحة المطلوبة قبل بداية السطر يعني مثلاً لو الصفحة هي صفحة "البطاقات الفردية" ودي أسندناها لمتغير باسم sh ..فنضع الـ sh قبل بداية السطر المطلوب جلب رقم آخر صفحة في الورقة المعنية sh.Cells(rows.count,1).end(xlup).row
    2 likes
  47. بالنظر إلى العلاقة بين الأفراد نجد الهيكل التنظيمي يكون كالتالي: وتكون الملفات موزعة كالتالي: طبعاً المشكلة لدينا هي عدم وجود ربط بين الملفات بالإضافة إلى عدم تمكن ابراهيم من الإطلاع على الملفات في أي وقت يريده.. ترقبوا الفكرة الأولى لإبراهيم .. تابعونا...........
    2 likes
  48. وعليكم السلام أخي صالح اعتذر منك على التأخر في الرد ردا على سؤالك: ما دام الكود شغال عندك وبدون مشاكل ، فعلى بركة الله ولكن رأيي هو ان تجعل الكود يعمل بالطريقة التالية: 1. ان تجعل الكود يتعرف على نسخة الاكسس التي تُستعمل الان (2003 او 2007 او... ) ، 2. على اساس النسخة ، يقول الكود بإستخدام الكود المناسب ، 3. بهذه الطريقة يكون الكود عام لجميع اصدارات الاكسس جعفر
    2 likes
  49. وعليكم السلام هو في حد جاب اسمي تفضل ، هذا كود زر فتح التقرير من النموذج Private Sub Command13_Click() 'On Error Resume Next DoCmd.OpenReport "salry3", acViewPreview Dim Filt As Variant If Me.Fr = 1 Then Filt = "[nam] ASC" ElseIf Me.Fr = 2 Then Filt = "[twqe] ASC" ElseIf Me.Fr = 3 Then Filt = "[draga] ASC" End If Reports!salry3.OrderBy = Filt Reports!salry3.OrderByOn = True End Sub في الواقع احنا ما محتاجين وضع امر ASC اي ترتيب تصاعدي ، لأنه الامر الافتراضي ، اذا لم نضع الامر Desc اي ترتيب تنازلي الكود اعلاه ما راح يشتغل في تقريرك ، لأنه عندك فرز في تقريرك (Sorting and Grouping) ، لذا يجب ازالت هذا الفرز اولا. واما اذا اردت الفرز ان يكون بحقلين ، بحيث الفرز الاول يكون للحقل الاول ، والفرز الثاني للحقل الثاني ، مثلا: Names Years 2001 jj 2000 ab 2001 zx 2000 aa فنريد الفرز بالسنة ثم الاسم ، وتكون النتيجة هكذا: 2000 aa 2000 ab 2001 jj 2001 zx فهنا يجب ان يكون الفرز بالحقلين ، ونبدا بحقل السنة ثم الاسم ، فيصبح الكود Filt = "[Years], [names]" ولاحظ اننا لم نستعمل الامر ASC لاننا لسنا بحاجة اليه جعفر
    2 likes
  50. السلام عليكم وحتى يكتمل الموضوع ، اخذت جزئية من احد برامجي ، وهي لحساب السنه والشهر واليوم ، يعني الحساب بالكامل . وهكذا ننادي الوحدة النمطية . والنتيجة . والوحدة النمطية Public Function YMDDif2(sDate1, sDate2) 'Public Function YMDDif2(sDate1, sDate2, Cont_Type, Res_Date) On Error GoTo err_YMDDif2 'sDate1 earliest date 'sDate2 later date 'Cont_Type = Contract Type 'Res_Date = Resignation Date Dim dInterim1 As Date ' If Cont_Type = "استقالة" Or Cont_Type = "متقاعد" Then ' sDate2 = Res_Date ' End If iMonth = DateDiff("m", sDate1, sDate2) If Day(sDate1) > Day(sDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, sDate1) iDay = DateDiff("d", dInterim1, sDate2) D = iDay M = iMonth Mod 12 Y = iMonth \ 12 YMDDif2 = CStr(Y) & " س/" & CStr(M) & " ش/" & CStr(D) & " ي" Exit Function err_YMDDif2: If Err.Number = 94 Then 'ignor, null Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . جعفر 473.2.db.mdb.zip
    2 likes