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

السلام عليكم اخواني الموضوع جميل ويحتمل افكار كتير وكذلك يمكن الدمج بين اكثر من فكرة وانا اخترت هذا الاخير فقمت بادماج عمل اخي سلطان مختار مع ادخال التكست بوكس في هذا العمل والتغيير في خاصية 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

السلام عليكم مثال قديم للأستاذ أبو هاجر لاستخدام الماسح ( السكانر ) عن طريق الأكسس قمت على تحديثه وزيادة السيطرة واستبعاد تخزين مسار الصور حيث لا داعي لها . مرفق ملف مكتبة dll يجب نسخه في مجلد Windows\System . لا تنسونا من دعاكم . تحياتي . الملفات المرفقة Scanner.rar ( 471.28ك ) عدد مرات التنزيل: 38

بشرى سارة من الذين يعانون من تحديد مسار الملف.. حيث تكمن المشكلة في تحديد اسم المستخدم والمجلد الذي يوجد به الملف.. ولقد جمعت لكم بعث الأمثلة لعل الله ينفع بي وبكم ما تقدموه لهذه الأمة.. إليكم المرفق. specific path.rar

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

أمس جه فى بالى ازاى أعرض على المستخدم رسالة على فترات زمنية متفطعة وكمان من غير ما يضغط المستخدم على زر زى 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

وعليكم السلام كما قال الاخ نور الدين: DoCmd.RunCommand acCmdSaveRecord For i = 1 To 2 اذا كان حقل التعريف ، مثلا ID ، اذا كان رقم: DoCmd.OpenReport "Report Name", , , "myID=" & Me.id اما اذا كان حقل التعريق نص : DoCmd.OpenReport "Report Name", , , "myID='" & Me.id & "'" Next i او اذا كان حقل التعريف ، مثلا ID ، اذا كان رقم: DoCmd.OpenReport "Report Name", acViewPreview, , "myID=" & Me.id, acHidden اما اذا كان حقل التعريق نص : DoCmd.OpenReport "Report Name", acViewPreview, , "myID='" & Me.id & "'", acHidden DoCmd.PrintOut , , , , 2 DoCmd.close acReport, "Report Name" جعفر

اخى عبد الناصر جرب الكود الاتى وهذا على حسب فهمى للمطلوب ............................................... اذا لم يفى الكود بالمطلوب يرجى وضع مرفق به مثال لما تريد 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 تقبل تحياتى

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

اخى الحبيب عبدالعزيز الاخ ابراهيم لا يريد الكود بتاعى انما هو يبحث عن الكود المرفق لماذا لا ياتى بالنتائج ( انا اعتقد ان الكود منقول ولكن ينقصه شئ بمعنى انه تم نقله بالخطا منقوص منه اسطر ) لكن الكود بتاعى انا انت لفت انتباهى لوجود خطأ فى النتائج لو لاحظت فى الصوره عاليه ستجد وجود 1700 علما انها اقل من 1800 فأنا عرفت اين الخطأ بالكود وتم تصليحه ممكن ارفع الملف بعد التعديل ولكن سيكون بدون فائده لان الاخ ابراهيم يريد شرح للكود الموجود بالملف عند رفعه تقبل تحياتى

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

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

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

تفضل غير كود الزر الى الكود: Dim Day1 As Integer Dim Month1 As Integer Dim Yer1 As Integer Day1 = 0 + D1 + D2 Month1 = 0 + M1 + M2 year1 = 0 + Y1 + Y2 D3 = Day1 Mod 30 M3 = (Day1 \ 30 + Month1) Mod 12 Y3 = (Day1 \ 30 + Month1) \ 12 + year1

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

اخي الحبيب حسام عيسي تسلم يداك علي هذا البرنامج وعلي الجهد الواضح المبذول والي الامام دائما تحياتي وتقديري

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

أفكار في التسطير يمكن وضع خط تحت الجمل عن طريق أيقونة التسطير U ... أو استخدام Ctrl+U و كل المستخدمين يعرف ذلك وهذه الطريقة تسطر الكلمات مع الفراغات التي بين الكلمات .. والذي يجهله كثير من الناس هو تسطير الكلمات فقط بدون الفراغات فيمكنك عمل ذلك عن طريق الأزرار Ctrl+Shift+W وإذا أردت وضع خطين تحت الجملة فيمكنك عمل ذلك عن طريق الضغط على الأزرار Ctrl+Shift+D استخدام زر نسخ التنسيق زر نسخ التنسيق (شكل فرشة) في برنامج (Word) وهو الزر بجانب زر اللصق .. والذي يقوم بنسخ التنسيق .. و له طريقتان في العمل .. الأولى مشهورة .. وهي التأشير على موضع تريد نسخ التنسيق .. ثم تضغط الزر .. ثم تؤشر على الموقع الثاني الذي تريد نقل التنسيق إليه.. وبهذه الطريقة تستخدم الزر مرة واحدة فقط .. أما الطريقة الأخرى وهي التي تخفى على الكثير .. وهي بالضغط على الزر مرتين بعد تحديد التنسيق المطلوب نسخه .. ثم تحديد جميع الأماكن التي تريد النسخ إليها.. ولا أذكر أيقونة في برنامج الـ Word يتم الضغط عليها مرتين .. إلا هذه الأيقونة تحياتى

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

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

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

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

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

اكتب فى الزر هذا الكود DoCmd.RunCommand acCmdSaveRecord DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPrintSelection

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

السلام غليكم جرب عذا الملف /لا حاجة الى صندوق الاختيار فقط اكتب حرف n او حرف y لظهور الباسورد و اي شيء اخر لا يفعل اي شيء الباسورد مرتبط الصفحة 2 و اذا ذهبت اليها لا تجد شيئاً Passwords1 salim.zip

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

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

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

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

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

اخي الفاضل ابو حبيبة هل الملف ادى المطلوب ام لا

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

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

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

السلام عليكم دالة الصفيف kh_MatchArray لارجاع ارقام صفوف سجلات حسب شروط الوسائط: عبارة عن صفيف يحقق (شرط / شروط) في عمود معين من قاعدة البيانات ادخل الشروط التي تريدها من 1 الى 30 الاستخدام : كشوفات الحساب التقارير بانواعها الميزة : لا ترهق الجهاز في المثال المرفق استخدمتها لقاعدة بيانات عدد سجلاتها اكثر من 15000 سجل والسبب انها معادلة وحدة نتائجها صفيف لهذا توضع على اكثر من خلية ولكن مكان تعديلها الخلية الاولى لوضعها مع تحديد باقي الصفوف الموضوعة فيها . اضغط F2 لتحرير الصيغة ثم اضغط CTRL+SHIFT+ENTER اذا حاولت تعدل اي خلية موضوعه فيها الدالة (جزء من صفيف الدالة) تظهر لك رسالة ( لا يمكنك تعديل جزء من صفيف) استخدم حينها ESC لانهاء تحرير الدالة . طبعا نتائجها ارقام الصفوف التي تحقق الشرط اعلى نطاق الدالة والاخرى رقم صفر بمعنى لا يحقق الشرط وهي اسفل النطاق تضعها في عمود يمين او يسار الكشف المتبقي علينا نستخدم دالة INDEX لاظهار الاعمدة الت نريدها من قاعدة البيانات كود الدالة: Option Explicit '============================================= '============================================= Function kh_MatchArray(ParamArray Array1() As Variant) Dim Ar() As Long Dim x As Integer, xx As Integer, xxx As Integer Dim iCont As Long, i As Long, ii As Long xx = UBound(Array1) If xx = -1 Then GoTo kh_Err iCont = UBound(Array1(0), 1) ReDim Ar(1 To iCont, 1 To 1) For i = 1 To iCont xxx = 1 For x = 0 To xx xxx = xxx * IIf(CBool(Array1(x)(i, 1)), 1, 0) Next If xxx Then ii = ii + 1: Ar(ii, 1) = i Next kh_MatchArray = Ar kh_Err: Erase Ar End Function المرفق 2003-2007 kh_MatchArray.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 بسيطة ؟ ..............

تكبير إطار النص .... ZoomBox في نموذج ادخال البيانات لدي حقل نصي أحتاج ان ادخل به معلومات تشكل مجموعة أسطر وليس لدى مساحة كافية في النموذج تكفي لمساحة الحقل الذي افكر به ، وفي اي نموذج آخر احتاج عرض البيانات المدخلة كاملة مع تميز النص المدخل في هذا الحقل بخط مختلف ولون مختلف بحيث تسهل قراءتها.... مهلا ... مهلا نتحدث هنا عن ZoomBox ، في نموذج إدخال البيانات وخلف مربع النص المعني استخدم الكود: Private Sub Text2_GotFocus() DoCmd.RunCommand acCmdZoomBox End Sub وفي اي نموذج وعند أي مربع نص وحين تحتاج عرض ZoomBox إضغط Shift+F2 ، وإقرأ البيانات بشكل مريح ، وإضبط خيارات النص بالضغط على Font… في ZoomBox ، وغير نوع الخط و الحجم واللون وشكل الخط مائل ... عريض ... ، وكما تشاء جرب هذه الفكرة فهي جديرة بتجربتها واستخدامها

هل سيكون لكل موظف شيت خاص به بإسمه وسيتم حساب عدد ساعات عمل كل موظف من شيته ؟؟ وهل سيكون الحساب شهرياً أم إسبوعياً ؟ وكم عدد الموظفين الذين سيتم حساب عدد ساعات عملهم ؟؟ لو تريد يمكن التعاون فى إعداد برنامج لحساب عدد ساعات العمل أعتقد سيكون وافياً دمت بخير

السلام عليكم ===== الشكر موصول لكل الاخوة والاحباب كل عام والجميع بالف خير الاخ mosha14 استخدم المعادلة =IF(E3>F3; 1-E3+F3;F3-E3)+IF(G3>H3; 1-G3+H3;H3-G3) لحساب مجموع الفترتين معا ويكون التنسيق على الشكل التالى hh:mm:ss شاهد المرفق presence and leave.rar

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

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

السلام عليكم ولاثراء الموضوع هنا حل اخر قوائم معدل.rar

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