كود طباعة وحفظ

[mohamedyousef]

السلام عليكم ورحمة الله ..السادة الافاضل بعد التحية

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

حفظ فاتورة.xlsm

[محمد هشام.]

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

نفضل اخي 

Private Sub CommandButton2_Click()
Dim wbNew As Workbook
Dim MH As String, ws As Worksheet
Dim val As String
Dim shape As Excel.shape
MH = CStr(Sheets("الفاتورة").Range("B1"))
val = Worksheets("الفاتورة").Range("a14")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("الفاتورة").Select
    Worksheets("الفاتورة").Copy
    Set wbNew = ActiveWorkbook
    With Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("a3").Select
    End With
 
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
Range("h4:h12").ClearContents
Range("c4:c12").ClearContents
Range("f4:f12").ClearContents
Range("A14").Value = val

        ActiveWorkbook.SaveAs Filename:= _
 "C:\Users\edb3\Desktop\" & MH & "-" & "فاتورة رقم" & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close

   Sheets("الفاتورة").Activate
   Range("b1").Value = Range("b1").Value + 1
   Range("h4:h12").ClearContents
   Range("c4:c12").ClearContents
   Range("f4:f12").ClearContents
   Range("a14").Formula = "=NumtoTxt(R[-1]C[6],""جنيهاً"",""قرشاً"")"
   Range("a3").Select
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
 
End Sub

Private Sub CommandButton3_Click()
Range("b1").Value = Range("b1").Value + 1
Application.Dialogs(xlDialogPrinterSetup).Show
ThisWorkbook.Sheets("الفاتورة").PrintOut copies:=1
Range("h4:h12").ClearContents
Range("c4:c12").ClearContents
Range("f4:f12").ClearContents
End Sub

 

حفظ فاتورة.xlsm