اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

وداعا تسلا .. اهلا بنظام الجديد :) - استخراج والطباعة التقارير صامت من غير صندوق الرسالة اجراءات الطباعة والعد (فقط انتظار )

hanan_ms

بواسطه hanan_ms
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

hanan_ms

hanan_ms

قام بنشر
قام بنشر

@ابو جودي والبتعله الحوت :biggrin:

اشرايك بشعار 😂

 

1- تنفيذ امر الاستخراج والطباعة صامت من غير صندوق الرسالة اجراء الطباعة وعد الصفحات انتظار فقط 

2- كود مبسط ثلاث حقول 

'Selected Objecit Print = (1) or PDF = (2) حدد النوع 
    Type_Object = 2
    'Name_report اسم التقرير 
    reportName = "report1"
    'If PDF Out Path File مسار الاستخراج 
    pdfPath = CurrentProject.Path & "\" & reportName & "_" & Format(Now(), "yyyymmdd_hhnnss") & ".pdf"

فقط 

Private Sub Comando0_Click()
'=============================( Msgbox
Dim strMsg_Give_Nmae                     As response
Dim Run_Cod1                             As Integer
Dim MsG1                                 As String
Dim MsG2                                 As String
Dim MsG3                                 As String
Dim iprgrs                               As Integer

Dim PDF_Print_Finction                    As String
Dim path_pdf                              As String
Dim Report_T                              As String
Dim Type_Object                           As String

Dim reportName                            As String
Dim pdfPath                               As String
Dim totalPages                            As Long

    'Selected Objecit Print = (1) or PDF = (2)
    Type_Object = 2
    'Name_report
    reportName = "report1"
    'If PDF Out Path File
    pdfPath = CurrentProject.Path & "\" & reportName & "_" & Format(Now(), "yyyymmdd_hhnnss") & ".pdf"

'===========================================================================================================
'*****************(Only_Code)*****************************
 ' جلب إجمالي الصفحات للتقرير
    totalPages = GetReportPageCount(reportName)
    Me.ProgressBar3.Min = 0
    Me.ProgressBar3.Max = totalPages
    Me.ProgressBar3.Value = 0

If Not ReportExists(reportName) Then
        MsG2 = "Sand Massage !"
MsG1 = "تم الغاء التنفيذ "
MsG3 = " لالتقرير غير موجود ولم نتمكن من العثور علية "

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Erorr_Job, Btn_Non, Arabic_Center ', True, 2.5
        Exit Sub
    End If

    Me.Comando0.Caption = "جار التنفيذ..."
    Me.xc.Caption = "اجمالي الصفحات.." & totalPages
    For iprgrs = 1 To 6 'totalPages - 1
    Me.ProgressBar3 = iprgrs
    Next
    
    
    If Type_Object = 2 Then
    Call externallyPDFSilent(reportName, pdfPath)
    Me.Comando0.Caption = "تصدير التقرير"
    End If
    
    If Type_Object = 1 Then
    Call externallyPrintSilent(reportName, pdfPath)
    Me.Comando0.Caption = "طباعة التقرير صامت"
    End If

    ' تحديث ProgressBar (هنا تحديث مبدئي، يمكنك توسعتها في حالة التصدير صفحة صفحة)
    Me.ProgressBar3.Value = totalPages
    Me.xc.Caption = "جاري المعالجة... 100%"
    Call externallyPrintSilent(reportName, pdfPath)
    
    If Dir(pdfPath) <> "" Then
If Type_Object = 2 Then
MsG2 = "Sand Massage !"
MsG1 = "تم التنفيذ تصدير PDF "
MsG3 = " لا يتوفر الان عملية تأمين الالي للبيانات بتاريخ واليوم "

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_OK, Btn_Non, Arabic_Center ', True, 2.5
End If

If Type_Object = 1 Then
MsG2 = "Sand Massage !"
MsG1 = "تم التنفيذ الطباعة "
MsG3 = " لا يتوفر الان عملية تأمين الالي للبيانات بتاريخ واليوم "

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_OK, Btn_Non, Arabic_Center ', True, 2.5
End If

'        MsgBox "تم إنشاء ملف PDF بنجاح:" & vbCrLf & pdfPath & vbCrLf & _
'               "إجمالي الصفحات: " & totalPages, vbInformation
    End If


End Sub

تحميل المرفق

https://www.mediafire.com/file/wrl147f1wl7uwmk/Silent-Print-with_Out_PDF.rar/file

hanan_ms

hanan_ms

قام بنشر
  • الكاتب
قام بنشر

😇 تحديث

1- تصحيح التوقيت التنفيذ للاحتساب عن طريق دالة  بسيطة

2- اضافة تاب سفلي كتغير واضافة الى النافذة بطريقة سهلة

----------------------------------------------

=========================(:biggrin:)

تحميل المرفق

https://www.mediafire.com/file/g4uyr43fywxh1jy/Update_Silent-Print-with_Out_PDF.rar/file

  • 2 weeks later...
hanan_ms

hanan_ms

قام بنشر
  • الكاتب
قام بنشر

:biggrin2: تحديـــــــــــــــــــــــث وتوسع

********************************************************** ( سهل )

اضافة ميزة اضافة شريط ازرار تاب ( بمجموعات ) كود بسيط جرب 

وافادة اكثر حول تصميم وتصاميم عند استاذ @Moosak :biggrin:

كود اسفل الفيديو مع تحميل المرفق ::

كود: 

تجربة التصميم تاب ومجموعات بسيط 
1- من خلال اداة (SpinButton) ActiveX

Private Sub SpinButton0_Updated(Code As Integer)
If Me.SpinButton0 = 1 Then
Me.RF_1.Caption = "تنبيهات المنتهي"
Me.RF_2.Caption = "تنبيهات قبل الانتهاء"
Me.RF_3.Caption = "تنبهات اجراءات مهملة"
Me.RF_4.Caption = "تأخيرات للصرف والتحصيل"

Me.X_M.Caption = "3-" & Me.SpinButton0
Exit Sub
End If

If Me.SpinButton0 = 2 Then
Me.RF_1.Caption = "كفالات بنكية"
Me.RF_2.Caption = "لم يتم تسليم المستندات"
Me.RF_3.Caption = "استعلام عن الشركات"
Me.RF_4.Caption = "استعلام عن جهات الطالبة"

Me.X_M.Caption = "3-" & Me.SpinButton0
Exit Sub
End If

If Me.SpinButton0 = 3 Then
Me.RF_1.Caption = "سهولة انشاء اشرطة متعددة"
Me.RF_2.Caption = "عرض التقرير مهما تغير تغيرة دقة الشاشة"
Me.RF_3.Caption = "مخططات النظم متقدمة"
Me.RF_4.Caption = "تقارير متقدمة :)"

Me.X_M.Caption = "3-" & Me.SpinButton0
Exit Sub
End If

2- كود بسيط لكل زر مرة واحدة فقط في التاب وهذه الاكواد لكل زر في الشريط من 1 الى 4 

Private Sub RF_1_Click()
'=========================(Code Run Skin)
If Me.RRR_1.Visible = False Then
Me.RRR_1.Visible = True
End If

If Me.RRR_2.Visible = True Then
Me.RRR_2.Visible = False
End If

If Me.RRR_3.Visible = True Then
Me.RRR_3.Visible = False
End If

If Me.RRR_4.Visible = True Then
Me.RRR_4.Visible = False
End If

If Me.TXT.Visible = True Then
Me.TXT.Visible = False
End If

Me.RF_1.BackColor = RGB(191, 191, 191)
Me.RF_2.BackColor = RGB(114, 114, 114)
Me.RF_3.BackColor = RGB(114, 114, 114)
Me.RF_4.BackColor = RGB(114, 114, 114)

'=========================(Code Run Button Only \ Grub SpinButton)
Dim MsG1                                 As String
Dim MsG2                                 As String
Dim MsG3                                 As String

If Me.SpinButton0 = 1 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 1 X1 Grub 1 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5

Exit Sub
End If

If Me.SpinButton0 = 2 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 1 X1 Grub 2 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If


If Me.SpinButton0 = 3 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 1 X1 Grub 3 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If

End Sub

Private Sub RF_2_Click()
'=========================(Code Run Skin)
If Me.RRR_2.Visible = False Then
Me.RRR_2.Visible = True
End If

If Me.RRR_1.Visible = True Then
Me.RRR_1.Visible = False
End If

If Me.RRR_3.Visible = True Then
Me.RRR_3.Visible = False
End If

If Me.RRR_4.Visible = True Then
Me.RRR_4.Visible = False
End If

If Me.TXT.Visible = True Then
Me.TXT.Visible = False
End If

Me.RF_2.BackColor = RGB(191, 191, 191)
Me.RF_1.BackColor = RGB(114, 114, 114)
Me.RF_3.BackColor = RGB(114, 114, 114)
Me.RF_4.BackColor = RGB(114, 114, 114)

'=========================(Code Run Button Only \ Grub SpinButton)
Dim MsG1                                 As String
Dim MsG2                                 As String
Dim MsG3                                 As String

If Me.SpinButton0 = 1 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 2 X1 Grub 1 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5

Exit Sub
End If

If Me.SpinButton0 = 2 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 2 X1 Grub 2 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If


If Me.SpinButton0 = 3 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 2 X1 Grub 3 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If

End Sub

Private Sub RF_3_Click()
'=========================(Code Run Skin)
If Me.RRR_3.Visible = False Then
Me.RRR_3.Visible = True
End If

If Me.RRR_2.Visible = True Then
Me.RRR_2.Visible = False
End If

If Me.RRR_1.Visible = True Then
Me.RRR_1.Visible = False
End If

If Me.RRR_4.Visible = True Then
Me.RRR_4.Visible = False
End If

If Me.TXT.Visible = True Then
Me.TXT.Visible = False
End If

Me.RF_3.BackColor = RGB(191, 191, 191)
Me.RF_2.BackColor = RGB(114, 114, 114)
Me.RF_1.BackColor = RGB(114, 114, 114)
Me.RF_4.BackColor = RGB(114, 114, 114)

'=========================(Code Run Button Only \ Grub SpinButton)
Dim MsG1                                 As String
Dim MsG2                                 As String
Dim MsG3                                 As String

If Me.SpinButton0 = 1 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 3 X1 Grub 1 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5

Exit Sub
End If

If Me.SpinButton0 = 2 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 3 X1 Grub 2 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If


If Me.SpinButton0 = 3 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 3 X1 Grub 3 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If

End Sub

Private Sub RF_4_Click()
'=========================(Code Run Skin)
If Me.RRR_4.Visible = False Then
Me.RRR_4.Visible = True
End If

If Me.RRR_2.Visible = True Then
Me.RRR_2.Visible = False
End If

If Me.RRR_3.Visible = True Then
Me.RRR_3.Visible = False
End If

If Me.RRR_1.Visible = True Then
Me.RRR_1.Visible = False
End If

If Me.TXT.Visible = True Then
Me.TXT.Visible = False
End If

Me.RF_4.BackColor = RGB(191, 191, 191)
Me.RF_2.BackColor = RGB(114, 114, 114)
Me.RF_3.BackColor = RGB(114, 114, 114)
Me.RF_1.BackColor = RGB(114, 114, 114)

'=========================(Code Run Button Only \ Grub SpinButton)
Dim MsG1                                 As String
Dim MsG2                                 As String
Dim MsG3                                 As String

If Me.SpinButton0 = 1 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 4 X1 Grub 1 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5

Exit Sub
End If

If Me.SpinButton0 = 2 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 4 X1 Grub 2 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If


If Me.SpinButton0 = 3 Then

MsG2 = "Sand Massage !"
MsG1 = "مارأيك في التصميم "
MsG3 = " التصميم سهل وليس معقد ببساطة " & vbCrLf & "***************************************" & vbCrLf _
& "تصحيح الوقت المتبقي" & vbCrLf & "Orc Mod 2025-2026 (( Button 4 X1 Grub 3 ))"

    MyMsgBox (MsG3), (MsG2), (MsG1), msg_Question, Btn_OK_Only, Arabic_Center ', True, 2.5


Exit Sub
End If

End Sub

تحميل المرفق :

https://www.mediafire.com/file/z0p7absaqc72iy1/SKin_Tab_with_GrubV1_Update_Silent-Print-with_Out_PDF.rar/file

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

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept