اذهب الي المحتوي
أوفيسنا

سامي الحداد

الخبراء
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    294

  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    1

 نوع المحتوي 

مشاركات المكتوبه بواسطه سامي الحداد

    كيفية فتح نموذج من شجرة Treeview

    في قسم الأكسيس Access

    قام بنشر

    منذ ساعه, tamer.murad said:

    السلام عليكم

    كل ماريده هو :

    Treeview  يكون عربي

    والفورم اسمها يكون انجليزي وليس عربي

    نعم أخي الكريم  تفضل  

    Private Sub TreeView1_Click()
   
    Dim strFormName As String
    Dim formsDictionary As New Scripting.Dictionary
    formsDictionary.ADD "بيانات الشركة", "frmCompany"
    formsDictionary.ADD "بيانات مستخدمي النظام", "frmSystemUserData"
    formsDictionary.ADD "كلمات المرور", "frmPassword"
    formsDictionary.ADD "بيانات المطورين", "frmDeveloper"
    strFormName = TreeView1.SelectedItem.Text
    If formsDictionary.Exists(strFormName) Then
        DoCmd.OpenForm formsDictionary(strFormName)
    Else
        MsgBox "عذرا هذا النموذج غير موجود", vbExclamation, "تنبيه"
    End If
End Sub

    واليك الملف بعد التعديل . 

    المكتبات المطلوبة انظر الصورة

    بالتوفيق 

    المكتبات المطلوبة.jpg

    MediaSoft 2.rar

    • Like 2

    كيفية فتح نموذج من شجرة Treeview

    في قسم الأكسيس Access

    قام بنشر

    وعليكم السلام 

    تفضل اخي الكريم هذا هو الكود المستخدم لفتح اي فورم عندك  

    Private Sub TreeView1_Click()
    Dim strFormName As String
    strFormName = TreeView1.SelectedItem.Text
    DoCmd.OpenForm strFormName
End Sub

    واليك الملف  بعد التعديل لقد اضفت لك كل النماذج . هل هو المطلوب؟

     

    MediaSoft 1.rar

    صلاحيات

    في قسم الأكسيس Access

    قام بنشر

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

    Private Sub Form_Open(Cancel As Integer)
Call UserPermission(Me, GetUserLoginID())

If TempVars!IsFormOpened = 1 Then
    Exit Sub
Else

    Call DisableButton(Me, GetUserLoginID, Me.cmdSetPermission, Me. اسم الزر المراد اخفاءه) 
End If
End Sub

     

    صلاحيات

    في قسم الأكسيس Access

    قام بنشر

    وعليكم السلام أخي الكريم

    بالنسبة ل All Forms فهي للادمن فقط. اما بالنسبة لزر  Disable Button فهو لاخفاء زر معين في نموذج أو من القائمة الرئيسية مثلا : في النموذج لديك مستخدم يستطيع ان يضيف ولكن لا يستطيع ان يحذف وهذا النموذج فيه اضافة وحذف هنا يأتي زر الاخفاء بحيث هذا المستخدم لا يستطيع ان يحذف, فقط يستطيع الاضافة.  لهذا اضفت هذه الخاصية لتعطيل زر معين. أدخل باسم المستخدم B على ما اعتقد سترى ان زر صفحة الادمن غير مفعلة. وهناك بعض الازرار مفعلة ولكن ليس لدية الصلاحية لفتح النموذج. واليك كيفية عمل ذلك..

    استدعاء وظيفة User Permission في كل نموذج ضمن الحدث Form_Open

    Private Sub Form_Open(Cancel As Integer)
           Call UserPermission(Me, GetUserLoginID())
    End Sub

    --------------------------------------------------------------------------
     إذا كان لديك بعض الأزرار لتعطيلها للمستخدم العادي ، فاستدع الوظيفة "UserPermission" و "DisableButton" ضمن حدث Form_Open

     

    Private Sub Form_Open(Cancel As Integer)
    Call UserPermission(Me, GetUserLoginID())

    If TempVars!IsFormOpened = 1 Then
        Exit Sub
    Else

        Call DisableButton(Me, GetUserLoginID, Me.cmdSetPermission) 
    End If
    End Sub

    يجب إضافة كل النماذج في جدول tbl_Forms ضروري.

    اتمنى ان اكون قد وفقت في الشرح وبخدمتكم.

    تحياتي

    صلاحيات

    في قسم الأكسيس Access

    قام بنشر

    أخي الكريم @العبيدي رعد

    الملف الذي ارفقته لك فيه كل ما طلبت يمكن جنابكم ما فتحتم الملف. 

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

    غير المستخدم سامي واجعله الادمن وغير اسماء المستخدمين واعطيهم الصلاحيات الطلوبه.

    بانتظار ردك.

    تحياتي

    • Like 1

    مساعدة قي طريقة البحث

    في قسم الأكسيس Access

    قام بنشر

    حياك الله اخوي @طاهر الوليدي

    نعم في الملف الاخير العملاء4 توجد هذه الخاصية تستطيع البحث في حقل الاسم فقط وذلك بازالة الاختيار من بافي الخانات , لقد ثبتت حقل الاسم في البحث في هذا المثال فقط لانة ممكن ان تتشابة البيانات مثل رقم العمارة او رقم الشقة مثلا لذلك وضعت حقل الاسم ثابت في البحث هذا فقط في هذا المثال. جرب الملف  اضغط على إلغاء التحديد ستبقى خانة الاسم فقط هي المتوفرة للبحث حاول ان تبحث عن اي شيء غير الاسم لن تحصل على اي نتيجة لان البحث والتركيز  فقط على حقل الاسم .  ارجو ان اكون قد وفقت في الاجابة على سؤالك واذا كان لديك اي استفسار اخر فانا بخدمتكم .

    تحياتي 

    • Like 1
    • Thanks 1

    مساعدة قي طريقة البحث

    في قسم الأكسيس Access

    قام بنشر

    السلام عليكم أخي @سيد رجب

    أسف جدا على التأخير لانشغالي بالعمل

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

    تفيل تحياتي وبالتوفيق

    العملاء4 .accdb

    • Thanks 1

    مساعدة قي طريقة البحث

    في قسم الأكسيس Access

    قام بنشر · تم تعديل بواسطه سامي الحداد
    إضافة شرح

    السلام عليكم

    تفضل أخي الكريم تم التعديل على ملفك في المشاركة الاولى . 

    هل هو المطلوب وافنا بالنتيجة.

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

     

    بالتوفيق

    image_2023-01-16_095502456.png

    العملاء 2.accdb

    عند الارسال واتساب تظهر الرسالة متلاصقة

    في قسم الأكسيس Access

    قام بنشر

    في 7‏/1‏/2023 at 16:38, حمدى الظابط said: 
    Dim IEE As Object
    Dim SQL As String
    Dim fso As Object
    Dim fldrname As String
    Dim fldrpath As String
    Dim Mytoname As String
    Dim stname1 As String

    Dim rs As DAO.Recordset
     Set rs = CurrentDb.OpenRecordset("email")
        rs.MoveLast: rs.MoveFirst
 Dim IE As Object

    DoCmd.RunCommand acCmdSaveRecord
    If Nz(DCount("SelectRow", "email", "SelectRow = 'R'"), 0) = 0 Then
    MsgBox "يجب اختيار المرسل اليه اولا", vbCritical + vbMsgBoxRight, "تنبيه"
    Exit Sub
    End If
    Me.myname.SetFocus
     If IsNull(Me.msg) Then
    MsgBox "لايوجد نص للارسال", vbCritical + vbMsgBoxRight, "تنبيه"
    Exit Sub
 End If
 If IsNull([email1].Form![phone_number]) Then
    MsgBox "لايوجد رقم هاتف", vbCritical + vbMsgBoxRight, "تنبيه"
    Exit Sub
 End If
    DoCmd.OpenForm "email4", acNormal
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "&  app_sent =0"
Pause 3
SendKeys "{TAB}"
Call SendKeys("~", True)

    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        While (Not rs.EOF)
         If rs.Fields("SelectRow") = "R" Then
           Mytoname = rs.Fields(0)
           stname1 = rs.Fields("toname")

Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text="

Pause 3

Set IE = Nothing
Set IEE = Nothing

Dim objClipboard As Object
Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objClipboard.SetText (MyFile)
objClipboard.PutInClipboard
Pause 5
SendKeys "+{TAB}"
Call SendKeys("{Enter}", True)
Pause 2
Call SendKeys("{Enter}", True)
Pause 5
Langauge ELanguage.en
Pause 5
Call SendKeys("^v", True)
Call SendKeys("{Enter}", True)
Pause 5
Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objClipboard.SetText (Me.msg)
objClipboard.PutInClipboard
Pause 1
Call SendKeys("^v", True)
Pause 5
Call SendKeys("{Enter}", True)
Pause 1

                DoCmd.SetWarnings False
                        DoCmd.RunSQL "UPDATE email SET[SendStuts]='تم الارسال' , SelectRow ='T' WHERE [ID]=" & Mytoname
                        DoCmd.Requery
                DoCmd.SetWarnings True
        
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"

         End If
            rs.MoveNext
        Wend
    End If
    rs.Close
    Set rs = Nothing    
MsgBox "تم الارسال"
End Sub

     أخي حمدي

    جرب الكود الان سبب تكرار الارسال هو هذه الاسطر  

    Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || " & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "&  app_sent =0"
Pause 3
SendKeys "{TAB}"
Call SendKeys("~", True)

    اليك الكود كاملا بعد التعديل 

    Dim IEE As Object
    Dim SQL As String
    Dim fso As Object
    Dim fldrname As String
    Dim fldrpath As String
    Dim Mytoname As String
    Dim stname1 As String

    Dim rs As DAO.Recordset
     Set rs = CurrentDb.OpenRecordset("email")
        rs.MoveLast: rs.MoveFirst
 Dim IE As Object

    DoCmd.RunCommand acCmdSaveRecord
    If Nz(DCount("SelectRow", "email", "SelectRow = 'R'"), 0) = 0 Then
    MsgBox "يجب اختيار المرسل اليه اولا", vbCritical + vbMsgBoxRight, "تنبيه"
    Exit Sub
    End If
    Me.myname.SetFocus
     If IsNull(Me.msg) Then
    MsgBox "لايوجد نص للارسال", vbCritical + vbMsgBoxRight, "تنبيه"
    Exit Sub
 End If
 If IsNull([email1].Form![phone_number]) Then
    MsgBox "لايوجد رقم هاتف", vbCritical + vbMsgBoxRight, "تنبيه"
    Exit Sub
 End If
    DoCmd.OpenForm "email4", acNormal
'Set IE = CreateObject("InternetExplorer.Application")
'IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "&  app_sent =0"
'Pause 3
'SendKeys "{TAB}"
'Call SendKeys("~", True)

    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        While (Not rs.EOF)
         If rs.Fields("SelectRow") = "R" Then
           Mytoname = rs.Fields(0)
           stname1 = rs.Fields("toname")

Dim strMSG As String
strMSG = " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub
strMSG = ReplaceLineBreaks(strMSG)
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & strMSG & "*" & "&  app_sent =0"
Pause 3

Set IE = Nothing
Set IEE = Nothing

Dim objClipboard As Object
Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objClipboard.SetText (MyFile)
objClipboard.PutInClipboard
Pause 5
SendKeys "+{TAB}"
Call SendKeys("{Enter}", True)
Pause 2
Call SendKeys("{Enter}", True)
Pause 5
Langauge ELanguage.en
Pause 5
Call SendKeys("^v", True)
Call SendKeys("{Enter}", True)
Pause 5
Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objClipboard.SetText ReplaceLineBreaks(Me.msg)
objClipboard.PutInClipboard
Pause 1
Call SendKeys("^v", True)
Pause 5
Call SendKeys("{Enter}", True)
Pause 1

                DoCmd.SetWarnings False
                DoCmd.RunSQL "UPDATE email SET[SendStuts]='تم الارسال' , SelectRow ='T' WHERE [ID]=" & Mytoname
                DoCmd.SetWarnings True
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"

         End If
            rs.MoveNext
        Wend
    End If
    rs.Close
    Set rs = Nothing
    
MsgBox "تم الارسال"
End Sub

' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل)
Function ReplaceLineBreaks(text As String) As String
    ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ")
    ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ")
    ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ")
End Function

    المعذرة أخي  لم أجرب الكود على البرنامج وذلك لانشغالي . جرب الكود هذا وان شاءالله عندما يسمح الوقت ساكون معكم .

    بالتوفيق

    • Like 1

    مساعدتكم في موضوع صلاحيات المستخدم

    في قسم الأكسيس Access

    قام بنشر

    وعليكم السلام ورحمة الله وبركاتة

    مشاركة مع الاستاذ خليفة جزاه الله خيرا

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

    المستخدمين كالتالي

    الاسم: علي       كلمة المرور 123

    الاسم: رضوان     كلمة المرور 123

    الاسم: سامي    كلمة المرور 555

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

    بالتوفيق

    ساغيب عن المنتدى لبضعة ايام بسبب السفر والعمل.

    PasswordLogin_RC4_v5.4.accdb

    اشكالية مع الدالة IF

    في قسم الأكسيس Access

    قام بنشر

    وعليكم السلام 

    مشاركة مع الاساتذة 

    تفضل التعديل 

    =IIf(Format([التاريخ],"yyyy/mm")<Format(Now(),"yyyy/mm") And [تم الدفع]=0,"قسط متأخر",IIf(Format([التاريخ],"yyyy/mm")>Format(Now(),"yyyy/mm") And [تم الدفع]=0,"لم يحن وقت السداد",IIf(Format([التاريخ],"yyyy/mm")=Format(Now(),"yyyy/mm") And [تم الدفع]=0,"جاهز للسداد"," تم السداد")))

     

    182.accdb

    • Like 2

    كيف اضيف عنصر جدبد للقائمة المنسدلة من دون الخروج منها

    في قسم الأكسيس Access

    قام بنشر

    21 ساعات مضت, المبارك55 said:

    السلام عليكم ورحمة الله

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

    لكم خالص التحية

    وعليكم السلام  اخي الكريم

    جرب التعديل ووافنا بالنتيجة

    تحياتي

    Database3.accdb

    • Like 1

    كيف اضيف عنصر جدبد للقائمة المنسدلة من دون الخروج منها

    في قسم الأكسيس Access

    قام بنشر

    وعليكم السلام 

    اخي الكريم بما انك لم ترفق ملفك اليك  هذا الكود عسى ان يكون هو طلبك ... 

    Dim strSQL As String
    Dim i As Integer
    Dim Msg As String
    Dim NewID As String

    If NewData = "" Then Exit Sub
    
   
    NewID = UCase(Trim(Left(NewData, 3)))

    Msg = "'" & NewData & "' غير موجود حاليًا في قائمة الأنواع." & vbCr & vbCr
    Msg = Msg & "هل تريد إنشاء سجل نوع جديد?"

    i = MsgBox(Msg, vbQuestion + vbYesNo, "نوع غير معروف...")
    If i = vbYes Then
        strSQL = "Insert Into [Your Table Here] ([Your ComboBox],[FieldName]) values ('" & NewID & "','" & NewData & "')"
        CurrentDb.Execute strSQL, dbFailOnError
        Response = acDataErrAdded
    Else
        Response = acDataErrContinue
    End If

    غير الاسماء حسب مسميات الحقول والقائمة المنسدلة والجدول لديك

    تحياتي

    اداة بحث ثورية

    في قسم الأكسيس Access

    قام بنشر

    18 دقائق مضت, Ahmed_J said:

    هل من الممكن على سبيل التجربة تساله عن كود للبحث عن نص في كل قاعدة البيانات (جميع الجداول)  وطريقة استداعه

    السلام عليكم 

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

    جرب ووافيني بالنتيجة

    ساضع البرنامج هنا مرة ثانية ربما يستفاد منة باقي الاعضاء

    تحياتي

    Search All Tables 2020 New.accdb

    • Like 1

    فتح تقرير غير منكمش اى اظهار ما بداخله وتصدير التقرير الى صيغة PDF

    في قسم الأكسيس Access

    قام بنشر

    3 دقائق مضت, الحلبي said:

    الله عليك استاذى الجميل / سامى 

    نعم هو المطلوب اثباته

    جزاكم الله كل خير وزادك الله علما كثيرا ـ احييك من كل قلبى على هذا الحل الجميل

    الشكر والتقدير لكم

    استاذى العظيم / موسى ولايهمك انا عارف ومقدر مشاغل الحياه كما انى اعرف انك لم تقصر ابدا فى مساعدة احد

    جزاكم الله كل خير

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

     تحياتي وبالتوفيق  

    فتح تقرير غير منكمش اى اظهار ما بداخله وتصدير التقرير الى صيغة PDF

    في قسم الأكسيس Access

    قام بنشر

     كل الود والاحترام لشخصكم الكريم اخي محمد الحلبي 

      

    2 ساعات مضت, الحلبي said:

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

    وهو  كذلك .. بحيث في حالة وجود الفولدر والملف بنفس التاريخ سوف تظهر رسالة بوجود اسم وتاريخ الملف وسيتم الغاء الحفظ.

    انظر للصورة .

    انا عملت على زر فتح ملف PDF فقط. وتأكدت  من الكود ايضا يعمل بصورة صحيحه.

    ارجو التجربة من جديد ومسح الملفات القديمة . بانتطارك اخي العزيز.

    تحياتي

     

     

    الحلبي.jpg

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

    في قسم الأكسيس Access

    قام بنشر

    في 18‏/12‏/2022 at 04:14, AbuuAhmed said:

    عساك ع القوة أخي سامي ، اقترح أن تجعل اسم الملف كالتالي:
      

    Format(Now(), "yyyy-mm-dd hh-nn-ss")

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

    الله يقويك أخوي واستاذي العزيز أبو اخمد 

    نعم كلامك صحيح ميه ميه .. واشكرك جزيل الشكر على المعلومة. 

    تحياتي 

     

    3 ساعات مضت, علياء يسرالدين said:

    الله يعافيك وينفع يعلمك .. بحثت في قوقل على رقم الخطأ وحملت ملف ميكروسوفت طباعة الى pdf والحمد لله مشي الحال ... شكرا شكرا على اهتمامك

    الخمدلله انك توصلت  للحل , واسف جدا لعدم التواصل وذلك لعدم تواجدي بالمنتدى .

    بالتوفيق 

    • Like 1

    فتح تقرير غير منكمش اى اظهار ما بداخله وتصدير التقرير الى صيغة PDF

    في قسم الأكسيس Access

    قام بنشر

    السلام عليكم 

    مشاركة مع أساتذتي جزاهم الله خيرا

    21 دقائق مضت, ابوخليل said:

    الاستنتاج : قد يكون هناك خللا آخر عندك انت فقط في قاعدة البيانات

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

    وهذه محاولتي بالنسبة لباقي السؤال.. زيادة مني شوي ..😄 

    اليك الكود. 

    Private Sub Command17_Click()
On Error Resume Next

Dim strPath          As String
Dim strFileName      As String
Dim strReport        As String
Dim OutPath          As String

    strReport = "T1"
    strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "T1" & "  " & Format(Date, "dd-mm-yyyy")
    If Dir(strPath, vbDirectory) = "" Then
    MkDir strPath
    
        OutPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "T1" & " " & Format(Date, "dd-mm-yyyy") & " " & ".PDF"
        MsgBox "  تم عملية انشاء المجلد مع تصدير الملف الى سطح المكتب", vbInformation, " تأكيد "
        strFileName = CurrentProject.Path & "\T1\" & strFileName

        DoCmd.OpenReport "t1", acViewReport, , "itemid=" & itemid & ""
        DoCmd.OutputTo acOutputReport, "t1", acFormatPDF, strPath & "\T1" & " " & Format(Date, "dd-mm-yyyy") & " " & ".PDF", True, , , acExportQualityPrint
        DoCmd.Close acReport, strReport
Else
    If strPath > 0 Then
    DoCmd.CancelEvent

    MsgBox " الملف موجود مسبقا بهذا الاسم والتاريخ " & vbCrLf & _
    "T1" & " " & Format(Date, "dd-mm-yyyy"), vbInformation + vbMsgBoxRight, "تم إلغاء العملية"
Exit Sub
End If
End If
End Sub

    أخي الدكتور محمد كنت قد سألتني عن ثلانة اشياء في هذه المشاركة 

    https://www.officena.net/ib/topic/117397-طباعة-محتويات-النموذج-على-ان-يكون-اسم-الملف-المطبوع-هو-تاريخ-اليوم-تلقائيا-عند-غلق-النموذج/

    هل هذا هو المطلوب في هذه المشاركة ايضا ام لا ؟

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

    تحياتي للجميع

    فتح تقرير غير منكمش.accdb

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

    في قسم الأكسيس Access

    قام بنشر

      

    3 ساعات مضت, علياء يسرالدين said:

    الله يعافيك

    اريد عند غلق النموذج يتم طباعة التقرير المرفق تلقائيا بدون تدخل مني وليكن مثلا على سطح المكتب ويكون اسم التقرير   17-12-2022.. وفي الغد يكون التقرير باسم 18-12-2022 .. وهكذا وهكذا بحيث في نهاية الاسبوع يكون لدي ارشيف

    وشكرا لك

    تفضلي اختي الكريمة

    حسب فهمي لطلبك ارجو ان يكون المطلوب.

    بالتوفيق

    طباعة عند اغلاق النموذج.accdb

    • Like 1
×
×
  • اضف...

Important Information

  I accept