نجوم المشاركات

السلام عليكم اخواني الموضوع جميل ويحتمل افكار كتير وكذلك يمكن الدمج بين اكثر من فكرة وانا اخترت هذا الاخير فقمت بادماج عمل اخي سلطان مختار مع ادخال التكست بوكس في هذا العمل والتغيير في خاصية PasswordChar وهذا يحل موضوع حفظ الباسورد في مكان اخر ارجو التجربة اخباري النتيجة تحياتي Passwords1.rar

السلام عليكم ورحمة الله وبركاته في الفيديو التالي نتعلم كيفية عمل فترة مؤقتة لملف اكسل بحيث يعمل الى عند تاريخ معين ويتم كشف المستخدم في حال قام بتغير تاريخ الجهاز أتمنى لكم مشاهدة مفيدة https://www.youtube.com/watch?v=e7TXbin6vc4

اخى عبد العزيز كود جميل ورائع بارك الله فيك تقبل تحياتى اخى عبد الناصر هذا كود اخر يفى بالمطلوب Sub trs_invoice() Application.ScreenUpdating = False Dim LR As Long, LR1 As Long Dim WS As Worksheet Dim WS1 As Worksheet Set WS = Worksheets("ÝÇÊæÑÉ ÈíÚ") Set WS1 = Worksheets("ÊÑÍíá ÇáÝÇÊæÑÉ") LR1 = WS1.Range("c55555").End(xlUp).Row + 1 Dim FR For R = 3 To LR1 If WS1.Cells(R, 3) = WS.Range("f6") Then MsgBox "This invoice already exist, No shift will done": Exit Sub Next For FR = 11 To 27 If WS.Cells(FR, 2) = "" Then GoTo 7 WS1.Cells(LR1, 2) = WS.Range("F7").Value WS1.Cells(LR1, 3) = WS.Range("F6").Value WS1.Cells(LR1, 4) = WS.Range("C6").Value WS1.Cells(LR1, 5) = WS.Range("C7").Value WS.Range("B" & FR & ":H" & FR).Copy WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False LR1 = LR1 + 1 7 Next FR Application.CutCopyMode = False WS.Select Application.ScreenUpdating = True End Sub تقبل تحياتى

أستادي الفاضل أنس فكرة جميلة لم تخطر ببالي .. لقد تم تعديل الكود لكي يعمل في حالة وجود صورة على خلفية الفورم أو بدون ملف للتحميل: https://app.box.com/s/6ahilnjx5zzae4ffnb8fyy3r6zwe9lgc صورة من الشاشة: الكود: 1- كود في اليوزرفورم موديول: Option Explicit Private WithEvents oAppEvents As Application Private Sub UserForm_Initialize() 'this bool flag is there to prevent the UserForm_Layout event from running when first activating the form bFlag = False ' hook the application events Set oAppEvents = Application Caption = "Adjustable Transparent UserForm -- (Client Area)" ScrollBar1.Min = 0 ScrollBar1.Max = 255 ScrollBar1.SmallChange = 3 ScrollBar1.Value = ScrollBar1.Min bytScrollBarVal = ScrollBar1.Min Label1.Caption = "Transparency : " & (100 * ScrollBar1.Value \ 255) & "%" Application.OnTime Now, "StoreTheInitialFormBackGround" End Sub Private Sub UserForm_Layout() 'Do not run the UpdateFormPicture sub when first activating the form If bFlag = True Then Call UpdateFormPicture End If End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Call CleanUp Set oAppEvents = Nothing End Sub Private Sub ScrollBar1_Change() bytScrollBarVal = ScrollBar1.Value Call UpdateFormPicture End Sub Private Sub ScrollBar1_Scroll() bytScrollBarVal = ScrollBar1.Value Call UpdateFormPicture End Sub Private Sub CommandButton1_Click() Unload Me End Sub 'Application events Private Sub oAppEvents_SheetActivate(ByVal Sh As Object) Call UpdateFormPicture End Sub Private Sub oAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call UpdateFormPicture End Sub Private Sub oAppEvents_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window) Call UpdateFormPicture DoEvents End Sub Private Sub oAppEvents_WorkbookActivate(ByVal Wb As Workbook) Call UpdateFormPicture DoEvents End Sub 2 - كود في ستاندار موديول: Option Explicit Private Type POINTAPI x As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type Private Type BLENDFUNCTION BlendOp As Byte BlendFlags As Byte SourceConstantAlpha As Byte AlphaFormat As Byte End Type Private Type LOGBRUSH lbStyle As Long lbColor As Long lbHatch As Long End Type Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) 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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long Private Declare Function SetBkMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nBkMode As Long) As Long Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long Private Const PICTYPE_BITMAP = &H1 Private Const SRCCOPY = &HCC0020 Private Const AC_SRC_OVER = &H0 Private Const OPAQUE = &H2 Private Const GWL_EXSTYLE = (-20) ' Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2 Private tRect As RECT Private hInitialDCMemory As Long Private frmHwnd As Long Private frmDc As Long Private hBrush As Long Private hBmp As Long Public bytScrollBarVal As Byte Public bFlag As Boolean Public Sub StoreTheInitialFormBackGround() Dim LB As LOGBRUSH Dim Realcolor As Long Dim tRed As OLE_COLOR, tGreen As OLE_COLOR, tBlue As OLE_COLOR 'retrieve the form hwnd and DC frmHwnd = FindWindow(vbNullString, UserForm1.Caption) frmDc = GetDC(frmHwnd) 'get the form's client dimensions GetClientRect frmHwnd, tRect 'create a memory DC and store the initial form backColor or Background picture in it for later blending hInitialDCMemory = CreateCompatibleDC(frmDc) With tRect hBmp = CreateCompatibleBitmap(frmDc, .Right - .Left, .Bottom - .Top) End With Call SelectObject(hInitialDCMemory, hBmp) DoEvents 'if the form has no picture set then store the form's backcolor in the memory DC If UserForm1.Picture Is Nothing Then 'convert system color to RGB TranslateColor UserForm1.BackColor, 0, Realcolor tRed = Val(CStr(Realcolor And &HFF&)) tGreen = Val(CStr((Realcolor And &HFF00&) / 2 ^ 8)) tBlue = Val(CStr((Realcolor And &HFF0000) / 2 ^ 16)) LB.lbColor = RGB(tRed, tGreen, tBlue) hBrush = CreateBrushIndirect(LB) SetBkMode hInitialDCMemory, OPAQUE FillRect hInitialDCMemory, tRect, hBrush Else 'if the form has a background picture then store the picture in the memory DC With tRect Call BitBlt(hInitialDCMemory, 0, 0, .Right - .Left, .Bottom - .Top, frmDc, .Left, .Top, SRCCOPY) End With End If 'set the bool Flag to indicate that the form has already been activated bFlag = True End Sub Public Sub UpdateFormPicture() Dim IID_IDispatch As GUID Dim uPicinfo As uPicDesc Dim IPic As IPicture Dim tPt As POINTAPI Dim BF As BLENDFUNCTION Dim lBF As Long Dim scrDc As Long Dim frmClientWid As Long Dim frmClientHgt As Long Dim hDCMemory As Long 'Update Label with current Transparency rate UserForm1.Label1.Caption = "Transparency : " & (100 * UserForm1.ScrollBar1.Value \ 255) & "%" 'brievely make the form fully transparent in order to capture the screen area underneath the form SetWindowLong frmHwnd, GWL_EXSTYLE, GetWindowLong(frmHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED SetLayeredWindowAttributes frmHwnd, 0, 0, LWA_ALPHA scrDc = GetDC(0) SetLayeredWindowAttributes frmHwnd, 0, 255, LWA_ALPHA 'retrieve the form's client dimensions GetClientRect frmHwnd, tRect With tRect frmClientWid = .Right - .Left frmClientHgt = .Bottom - .Top End With 'create a memory DC to hold the screen area underneath the form hDCMemory = CreateCompatibleDC(scrDc) hBmp = CreateCompatibleBitmap(scrDc, frmClientWid, frmClientHgt) Call SelectObject(hDCMemory, hBmp) tPt.x = tRect.Left: tPt.Y = tRect.Top ClientToScreen frmHwnd, tPt Call BitBlt(hDCMemory, 0, 0, frmClientWid, frmClientHgt, scrDc, tPt.x, tPt.Y, SRCCOPY) 'blend the form's initial backcolor with the screen image underneath the form With BF .BlendOp = AC_SRC_OVER .BlendFlags = 0 .SourceConstantAlpha = 255 - bytScrollBarVal .AlphaFormat = 0 End With RtlMoveMemory lBF, BF, 4 AlphaBlend hDCMemory, 0, 0, frmClientWid, frmClientHgt, hInitialDCMemory, 0, 0, frmClientWid, frmClientHgt, lBF 'Set the Form's Picture property to the resulting blended memory Bitmap With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With uPicinfo .Size = Len(uPicinfo) ' .Type = PICTYPE_BITMAP .hPic = hBmp .hPal = 0 End With OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic Set UserForm1.Picture = IPic 'cleanUp ReleaseDC frmHwnd, frmDc DeleteDC hDCMemory ReleaseDC 0, scrDc End Sub Public Sub CleanUp() DeleteObject hBrush DeleteObject hBmp bFlag = False End Sub

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذنا الفاضل عادل حنفي .. على الاضافة المميّزة .. بارك الله فيك .. جزاك الله خيرًا و زادك من علمه و فضله .. خالص احتراماتي

السلام عليكم ورحمة الله قمت بتبديل الدالة VLOOKUP بدالة أخرى OFFSET مع الدالة MATCH مع تعديلات على تنسيقات شيتات الملف... بن علية خط سير شهرى3.rar

السلام عليكم استخدم المعادلة التالية =VLOOKUP($A4&$D$2;CHOOSE({1,2};واجهه!$A$4:$A$500&MONTH(واجهه!$G$4:$G$500);واجهه!$E$4:$E$500);2;0) هذه معادلة صفيف بعد كتابتها يتم الضغط على CTRL + SHIFT + ENTER وليس ENTER فقط اليك المرفق خط سير شهرى2.rar

السلام عليكم ورحمة الله وبركاته اخواني الاعزاء هنا ملف كامل لكيفية استخدام الUserForm وكيفية التعامل معه وبجميع أدواته المستخدمة مع شرح الخصائص المتعلقة به وبادواته كذلك تم شرح الاكواد الخاصة به وبادواته وتم استخدام الصور والامثلة العملية في الشرح وبصورة ميسرة وبسيطة حتى يتم استيعابها بالصورة المطلوبة وتم تقسيم العمل الى ستة ملفات وبصورة تسلسلية اخوكم عماد الحسامي الدرس الأول UserForm.rar الدرس الثاني.rar الدرس الثالث textbox.rar الدرس الرابع.rar الدرس الخامس.rar الدرس السادس.rar الدروس السته مجمعه.zip

السلام عليكم ورحمة الله وبركاته أقدم لكم اليوم شرح مفصل لدالة العد بشرط COUNTIF مع الصور أولا : إذا كنت تريد عد الخلايا التى بها إسم التقرير Report فقط كما موضح بالصورة فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,”REPORT”) ثانيا : إذا كنت تريد عد القيم التى أكبر من رقم 10 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,">"&10) ثالثا : إذا كنت تريد عد القيم التى أكبر من أو يساوى رقم 10 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,">="&10) رابعا : إذا كنت تريد عد القيم التى لا تساوى رقم 10 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"<>"&10) خامسا : إذا كنت تريد عد القيم التى أقل من رقم 40 ولكن أكبر من رقم 15 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"<"&40)-COUNTIF(C2:C10,"<="&15) سادسا : إذا كنت تريد عد القيم التى أكبر من رقم 40 ولكن أقل من رقم 15 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,">"&40)+COUNTIF(C2:C10,"<"&15) سابعا : إذا كنت تريد عد الخلايا التى بها إسم التقرير Report كما موضح بالصورة حتى لو كان مقترن بكلمة أخرى فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"*REPORT*") ثامنا : إذا كنت تريد عد الخلايا التى بها إسم التقرير Report كما موضح بالصورة بحيث تكون إسم التقرير Report فى بداية الجملة فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"REPORT*") تاسعا : إذا كنت تريد عد الخلايا التى ينتهى أخرها ب RT فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"*RT") عاشرا : إذا كنت تريد عد الخلايا التى ينتهى أخرها ب RT ويكون إجمالى النص بالخلية 6 أحرف فقط فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"????RT") إحدى عشر : إذا كنت تريد عد الخلايا التى تحتوى على أى نص فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"*") إثنا عشر : إذا كنت تريد عد الخلايا التى لا تحتوى على أى نص فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,"<>"&"*") ثلاثة عشر : إذا كنت تريد عد القيمة التى أكبر من أو تساوى القيمة التى فى الخلية C12 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,">="&C12) أربعة عشر : إذا كنت تريد عد القيمة التى أكبر من القيمة التى فى الخلية C12 فتكون صيغة الدالة كالتالى : =COUNTIF(C2:C10,">"&C12) أرجوا من الله العلى القدير أن ينال رضاكم وأكون قد وفقت فى توصيل المعلومة

السلام عليكم ورحمة الله وبركاته أساتذتى الكرام : اللذين أدين لهم بالفضل والعرفان بكل ما تعلمته فى الإكسيل أحبابى وأصدقائى : أعضاء منتدانا العريق ( منتدى أوفيسنا ) أقدم لكم كنترول الإعدادى رجب جاويش الإصدار رقم 15 للترمين والدور الثانى 2015 يشمل كل الأعمال الخاصة بالترم الأول والترم الثانى والدور الثانى ملاحظات هامة يمكن إختيار الفرنسى للمحافظات المطبق عليها الفرنسى أو اختيار بدون للمحافظات التى لا يطبق عليها الفرنسى ويمكن اختيار الانجليزى مستوى رفيع للمادرس التجريبية يصلح لأى قرار وزارى سواء 313 أو 460 تحية لمنتدانا الغالى ولأعضائه الكرام وعذرا لأى خطأ أوسهو أخوكم رجب جاويش بعض واجهات البرنامج كنترول الإعدادى رجب جاويش الإصدار 15.rar

بسم الله الرحمن الرحيم الاخوة والاخوات فى هذا الصرح العظيم أقدم لكم اليوم الاصدار الثالث من برنامج EMA يشمل جميع الامور المحاسبيه هذه النسخه نسخه تجريبيه يرجى من الاخوة المحاسبين والمهتمين بالامور المحاسبية التجربه والتقييم للوصول الى الافضل ان شاء الله بنزل الشرح عن كيفية الاستخدام والتعامل مع البرنامج اى سؤال أو استفسار لا تترد وأنا تحت امركم كلمة المرور - الدعم الفني الباسورد - 123 تفضل نسختك EMA.zip

أمس جه فى بالى ازاى أعرض على المستخدم رسالة على فترات زمنية متفطعة وكمان من غير ما يضغط المستخدم على زر زى ok cancel Retry ..... طبعا الرسائل العادية المعروفه لا تمكنا من ذلك خاصة وأن فيها على الأقل زر ok فكتبت هذا الكود مستخدما اليوزر فورم لعرض رسالة على فترات زمنية متفطعة على المستخدم Option Explicit Sub showUF() Dim i As Integer For i = 1 To 3 'عدد مرات العرض Application.OnTime Now + TimeValue("00:00:01"), "UnloadUF" ' مدة عرض الفورم UserForm1.Show Next i End Sub Sub UnloadUF() UserForm1.Hide Application.Wait Now + TimeValue("00:00:01") ' مدة اختفاء الفورم End Sub كيفية عرض عدة رسائل على المستخدم على فترات زمنية متقطعة لتنفيذ هذا يلزم عدد معين من اليوزر فورم كل فورم به رسالة مختلفة فاستخدمت أسلوب المصفوفات فى عرض هذه الرسائل على المستخدم فكان هذا الكود الذى يعرض عددا من اليوزر فورم زاحد تلو الآخر Option Explicit Dim X As Integer Dim iuserform As Variant Sub showUF() ' by mokhtatr 19/9/2015 iuserform = Array(UserForm1, UserForm2, UserForm3, UserForm4) For X = LBound(iuserform) To UBound(iuserform) Application.OnTime Now + TimeValue("00:00:01"), "UnloadUF" ' مدة العرض iuserform(X).Show Next X End Sub Sub UnloadUF() iuserform = Array(UserForm1, UserForm2, UserForm3, UserForm4) iuserform(X).Hide Application.Wait Now + TimeValue("00:00:01") End Sub تفضلوا المرفقات كل عام وأنتم بخير displays a timed messages on the UserForm by mokhtar.rar displays a timed message on the UserForm by mokhtar.rar

السلام عليكم ورحمة الله وبركاته كل الشكر والتقدير لكل اللى شاركوا فى مساعدتى بجد أنا متشكر جدا جدا لقد تم أثراء الموضوع بحلول متعددة انا محتار اختار مين افضل اجابه ؟؟؟؟ ينفع اختارهم كلهم والسلام عليكم

وعليكم السلام أخي للأسف ، هذه مشكلة في الاكسس ، في النموذج المستمر ، عندما يأخذ مربع السرد والتحرير قيمته استنادا على حقل آخر الحل هو: اعمل نسخة من SQL استعلام مربع سرد وتحرير حقل الوحدة ، اعمل استعلام جديد ، انا اسميته qry_INV100_Unite ، اعمل النموذج المستمر frm_INV100_Unite ، اللي يأخذ بياناته من الاستعلام qry_INV100_Unite ، في النموذج الفرعي INV100 ، احذف المعيار من حقل الوحدة ، في الحدث "بعد التحديث" للحقل "رمز المادة" ، افتح النموذج frm_INV100_Unite (والذي سيكون مصفى حسب "رمز المادة" ، اضغط على زر Ok للمادة التي تريدها ، وسترى ان القيمة انتقلت لحقل الوحدة في النموذج الفرعي INV100 ، وسيغلق النموذج frm_INV100_Unite سهله هه جعفر 220.البرنامج.accdb.zip

اخى عبد الناصر جرب الكود الاتى وهذا على حسب فهمى للمطلوب ............................................... اذا لم يفى الكود بالمطلوب يرجى وضع مرفق به مثال لما تريد Sub trs_invoice() Application.ScreenUpdating = False Dim LR As Long, LR1 As Long Dim WS As Worksheet Dim WS1 As Worksheet Set WS = Worksheets("فاتورة بيع") Set WS1 = Worksheets("ترحيل الفاتورة") LR1 = WS1.Range("c55555").End(xlUp).Row + 1 Dim FR For R = 3 To LR1 If WS1.Cells(R, 3) = WS.Range("f6") Then MsgBox "This invoice already exist, No shift will done": Exit Sub Next For FR = 11 To 27 If WS.Cells(FR, 2) = "" Then GoTo 7 WS1.Cells(LR1, 2) = WS.Range("F7").Value WS1.Cells(LR1, 3) = WS.Range("F6").Value WS1.Cells(LR1, 4) = WS.Range("C6").Value WS1.Cells(LR1, 5) = WS.Range("C7").Value WS.Range("B" & FR & ":H" & FR).Copy WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS1.Range("M" & LR1).Value = WS1.Range("H" & LR1) - WS1.Range("L" & LR1) LR1 = LR1 + 1 7 Next FR Application.CutCopyMode = False WS.Select Application.ScreenUpdating = True End Sub تقبل تحياتى

استاذي الفاضل عبدالعزيز واستاذي الفاضل ابراهيم جزاكم الله خيرا .. شكراااا بجد علي الجهد المبذول انا بتعلم كل يوم منكم معلومة جديدة ... ربنا يكرمكم يارب

وعليكم السلام أستاذ علي يمكن "تقريبا" عمل كل شئ في الاكسس بس لوسمحت: ارفق قاعدة بيانات فيها بيانات ، واعمل لي سواء بالاكسل او الوورد او بصورة ، النتيجة النهائية اللي تريدها جعفر

السلام عليكم اخى الكريم مع انى افضل طريقة الاخ ابو عارف لانها الطريقة الصحيحة لبناء البرنامج تفضل هذا المرفق فيه ما طلبت مباشرة مع الاحتفاظ بالجداول ودون تعديل اصدار التراخيص.rar

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

احسنت .... عمل رااااائع

وبارك الله فيك اخي عبد العزيز شاكرا لمرورك تحياتي

اخى الكريم البرنامج محاسبى شامل وفيه مخازن ممتاز ومجانى لا نبتغى غير دعائك تقبل تحياتى

وهذا ملف يحافظ علي لون الخلية والبوردر افسينا1 .rar

اخي ابو سليمان جرب المرفق وان شاء الله يكون المطلوب تحياتي افسينا .rar

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

أخي الكريم جرب الكود التالي Sub AddCheckboxes() Dim Cell As Long, LRow As Long Dim chkbx As CheckBox Dim MyLeft As Single, MyTop As Single, MyHeight As Single, MyWidth As Single Application.ScreenUpdating = False LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row For Cell = 2 To LRow If Cells(Cell, "A").Value <> "" Then MyLeft = Cells(Cell, "G").Left MyTop = Cells(Cell, "G").Top MyHeight = Cells(Cell, "G").Height MyWidth = Cells(Cell, "G").Width Cells(Cell, "F").NumberFormat = ";;;""****""" With ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight) .Caption = "" .Value = xlOff .Display3DShading = False .OnAction = "CheckBox_Click" End With End If Next Cell Application.ScreenUpdating = True End Sub Sub RemoveCheckboxes() ActiveSheet.CheckBoxes.Delete End Sub Private Sub CheckBox_Click() With ActiveSheet.Shapes(Application.Caller) .TopLeftCell.EntireRow.Range("F1").NumberFormat = IIf(.ControlFormat.Value = xlOn, "general", ";;;""*****""") End With End Sub

أخي الحبيب الزباري عوداً حميداً ونتمنى تواجدك الدائم معنا بالمنتدى .. موضوع رائع ومفيد جداً تسلم الأيادي

ضع كود الانتقال بين السجلات في حدث عند التركيز للزر

1-اذهب الى الصفحة رقم 2 2- أضغط Alt+F11 يظهر لك الكود التابع لهذه الصفحة (هناك كودين) 3- في الكود الثاني اختر النطاق المناسب (في حالة الملف بين يديك من A6:A13) 4- قم بتعبئتة على هذا الشكل Range("a6") = "الباسورد الاول" Range("a7") = "الباسورد الثاني" Range("a8") = "الباسورد الثالث" و هكذا الى النهاية ثم احفظ الملف وهذا كل شيء

السلام عليكم ورحمة الله وبركاته استجابة لطلب أخي وحبيبي في الله ياسر خليل أبو البراء..وفقه الله إلى كل خير المتعلق بوضع المرفقات ضمن مشاركة واحدة أقترح تجميع كل المرفقات في مشاركة واحدة حتى يسهل على من حضر الموضوع متأخراً أن يلملم المرفقات مرة واحدة بلا جهد وبلا مشقة المصفوفات في الإكسيل جزء1 المصفوفات في الإكسيل جزء2 سلسلة علمني كيف أصطاد1 شرح مفصل للدالة countif دراسة متأنية لفورم صرف المعلومات المهمة عن الـ VBA

السلام عليكم ورحمة الله وبركاته أقدم لكم دراسة متأنية لسند صرف أعده الأستاذ الكريم ضاحي الغريب ...تشرفت بإعداد هذه الدراسة بعد أن قام الأستاذان الكريمان ياسر خليل والصقر بمشاركات فعالة ولا أنسى دور الأستاذين ضاحي الغريب وخالد الرشيدي الكريمين بتوضيح بعض المسائل الهامة بها. أرجو قبولها من أخ لكم مبتدئ والعفو عن الزلل والخطأ والسهو والنسيان ...والسلام عليكم دراسة متأنية لفورم سند صرف.rar

الاخ الحبيب /ياسر جزاكم الله خيرا وجعل اعمالكم فى ميزان حسناتكم تقبل تحياتى

السّلام عليكم و رحمة الله و بركاته أخي ابن الملك إجابة الأخ الكريم سلطان مختار تفي تمامًا بالغرض .. أين المشكلة إذن !!؟؟ خالص احتراماتي

بسم الله ما شاء الله عليك أخي المتميز مختار أنا بفضل إنك متفصلش واصل بلا فواصل شغلت الملف وجات الرسالة الخاصة بتحذير الانفجار ومسكت قلبي .. قلت ف بالي ربنا يستر والجهاز ميحصلوش حاجة وينفجر ولما خلص زعلت إنه منفجرش ..كان نفسي يحصل حاجة جديدة (في انتظار التفجير في الإصدار القادم) وعلى فكرة أنا هبلغ عنك بتهمة الإرهاب (بلاش شغل الإرهاب والتفجير والكلام ده .. عشان فيه ناس زي حالاتي بتصدق)

***السلام عليكم ورحمة الله وبركاتة*** اخي الكريم تفحص المرفق انتخابات .rar

اخي الفاضل تفحص المرفق Passwords1.rar

السلام عليكم ورحمة الله وبركاته اولا اتقدم بالشكر الجزيل لجميع اعضاء المنتدى الرائع الذي ينتفع منه الجميع ، الحقيقة يا اخوتي الاكارم بالنسبة لي فقد انتفعت من المنتدى الجميل في مواضيع كثيرة من الاكسل ثانيا : ارجو من السادة الافاضل مساعدتي على حل هذه المشكلة في الملفين المرفقين ، فانا اريد ترحيل البيانات من الملف الاول المسمى "تفاصيل" الى الملف الثاني الذي اسمه "Z" فمنذ عملي لهذا الكود عمل بشكل جيد لفترة 10 ايام والان لا يعمل ويكتب لي عبارة " run-time error '9' : subscript out of range" يرجى المساعدة ولكم مني جزيل الشكر ترحيل الى ملف خارجي.rar

بارك الله فيك أستاذي الغالي ياسر خليل على المساعدة و الشرح ..هل ممكن أستاذي الفاضل تطبيق هذا الكود على هذا الملف ولتكن الخلية الأولى لبداية الادخال H15 مثلا فقط لأفهم مواضع تغيير الأرقام الأولى بالكود .. الفورم1.rar

اليك اخي الفاضل الملف تواريخ.rar

الاخ صلاح و الاخ ياسر انا غلبتكم معي كثير و لكن صديق لي حضر و معة الجهاز الخاص به و عندة نفس المشكلة و فعلا هي مشكلة في additional controls نتيجة تحديث معين في الاوفس وانا الان احاول الوصول لحل لها ولكن قمت ببعض التعديلات و بالفعل تم تنفيذ الملف على جهاز صديقي بدون مشاكل أرجو أن يعمل لديكم و لدي باقي أعضاء المنتدي والحل كان في استبدال TextBox باستخدام ComboBox و استبدال CheckBox باستخدام OptionButton الملف المعدل اتمني أن يعمل لديكم الملف New Copy And Paste 2015.rar

يا رب تعجبكم Bowling.rar

الأستاذ / إبراهيم حسين محمد السلام عليكم ورحمة الله وبركاته إليك الملف به المطلوب. A1.rar

السلام عليكم الكود منقول وهو للاخ (amroomo) مع إضافة بضع التناتيش عليه ليتناسب وطلبك الكود سيقوم بحفظ نسخة من الفاتورة في ملف باسم العيادة في الدرايفر D فاذا كان اسم العيادة موجود مسبقاً يتم اضافة العمل الى هذه العيادة والا يقوم بانشاء فولدر جديد جرب واعلمني بالنتيجة BSI2.zip

عدم وجود معلومات في النموذج ... No records to support form display في نموذج البحث وعند محاولة عرض نتائج البحث في نموذج ثاني منفصل ، وعند عدم وجود نتائج للبحث يظهر النموذج فارغا أو تظهر رسالة خطأ. أريد رسالة تنبيه بعدم وجود معلومات في النموذج كنتائج بحث ، كما في التقارير !!! الحل في الكود التالي ، وينسخ في حدث عند الفتح للنموذج الثاني (إظهار نتائج البحث) ، حيث يتم تنبيه المستخدم برسالة ، ثم يعود لنموذج البحث ويفرغ حقل نص البحث . Private Sub Form_Open(Cancel As Integer) On Error Resume Next If Me.RecordsetClone.RecordCount = 0 Then MsgBox "No records to support form display", vbExclamation, "System Message" DoCmd.CancelEvent Forms!frmSearchD!txtSearchText.SetFocus Forms!frmSearchD!txtSearchText = "" Exit Sub End If End Sub بسيطة ؟ ..............

ملحوظة ... الساعة 11:00 م .. قمت بكتابتها بهذا الشكل 23:00 وقام الاكسيل بتحويلها ل 11:00 م ..

في المرفات خطوط الباركود والآداة ومثال اكسس ومثال وورد لطباعة الملصقات خارج اكسس ومفكرة تعليمات زيادة على الملاحظات والتعليمات في ثنايا الامثلة الموضوع قد اشبع بحثا وطرحا في المنتديات المتخصصة لمن اراد الاستزادة Barcode.rar

أخي العزيز / skyblue رجاء الاطلاع على المرفق وبه طلبك إن شاء الله . تحياتي أبو عبدالله قوائم-1.rar

السلام عليكم ورحمة الله وبركاته كما وعدتكم أحبتي ، في الملف المرفق بعض الايقونات الخاصة بالبرامج والتي يتم ربطها بالماكرو هذه عينه مبدئية مع العلم بأني على استعداد تام للتصميم حسب الطلب لعيونكم : ) ملحوظه : الايقونات اسفل الخط الأسود من تصميمي . ----------- والشكر موصول لصاحب الفكرة الأخ الحبيب / أبو عبد الله ايقونات.rar

أخي العزيز / ابو عبدالله (الجزيرة) أيقونات رائعة وللمشاركة بالفكرة وتشجيعاً لمن لديه أيقونات اسمح لي أضيف هذه المجموعة . تقبل تحياتي أبو عبدالله ايقونات - 1.rar

السلام عليكم ورحمة الله اخي العزيز كل عام وانت بالف خير وعافية ولك من ساهم وساعد في بناء هذا المنتدى الطيب لااعرف كيف اشكرك على هذا الصنيع كما اشكر فيك روح التعاون وهذه اليد الكريمة التي كتبك لي تلك الحلول واجهدت فكرها في سبيل تحقيق السعادة لللغير طلبي ان كان متواضعا هو كيف عندما اظع الماوس على الخلية يظهر السهم للقائمة المنسدلة فهل هو مربع السرد والتحريرام غيره اذ لا توجد فيه هذه الميزة ام اماذا كما لدي طلب هو ان تشرح لي كيف عملت البرنامج لآن عندما انسخ الورقة في المكان الذي احتاجه لا يعمل عندي الا على الملف الذي بعثته لي وبذلك يذهب العمل سدى اذا تكرمت وشرح لي وفهذا عهدي بك وهذا لطف منك لأنني لم اجد ماكرو مرئي ام توجد طريقة لااعرفها فعرفها لي واشهد انك كسبت صديقا حميما لك وكل هذا مع الشكر والتقدير وان اخجل من كثرة طلباتي ملاحظة وجدت البرنامج الذي وظعته اخيرا لا يعمل عندي مع العلم ان الذي قبله يعمل (كانه ورقة عادي لاتعمل فيها عند الظغط على اي شخص) لا اعرف السبب والىالخير فسارع فهذا ميزان الحسنات اراه يزداد في ميزانك ___________________________________.rar