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

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

قام بنشر

@ابو جودي والبتعله الحوت :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

قام بنشر

😇 تحديث

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

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

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

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

تحميل المرفق

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

×
×
  • اضف...

Important Information