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

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

قام بنشر

السلام عليكم

محتاج في تعديل الكود

الفكره المطلوبة هي عند تحول العداد من رقم الى رقم جلب البيانات وحفظ الفاتورة 

الموجود حاليا - عدم جلب البيانات - عند تحول العداد من رقم الى رقم 

وذلك بسبب يريد مني الضغط على انتر في كل مرة لجلب البيانات

المطلوب - الاستغناء على الانتر لجلب البيانات

جزيتم خيرا

وصل - عداد - جلب بيانات.xlsm

  • تمت الإجابة
قام بنشر

Hello. Try the following code that is not exactly as you need but give it a try

All the bills will be exported to only one pdf to Desktop instead of creating a pdf for each bill

Sub Export_All_Bills_To_One_PDF()
    Dim bill, wb As Workbook, wsData As Worksheet, wsBill As Worksheet, wsCounter As Worksheet, shp As Shape, lr As Long, ls As Long, r As Long, m As Long, n As Long
    Application.ScreenUpdating = False
        With ThisWorkbook
            Set wsData = .Worksheets(1): Set wsBill = .Worksheets(2): Set wsCounter = .Worksheets(3)
        End With
        lr = wsCounter.Cells(Rows.Count, "A").End(xlUp).Row
        ls = wsData.Cells(Rows.Count, "B").End(xlUp).Row
        Set wb = Workbooks.Add(xlWBATWorksheet)
        For r = 2 To lr
            wsBill.Range("D1").Value = wsCounter.Cells(r, 1).Value
            bill = wsBill.Range("A2").Value
            wsBill.Range("A6:B30").ClearContents: n = 6
            For m = 3 To ls
                If wsData.Cells(m, "B").Value = bill Then
                    wsBill.Range("A" & n).Resize(, 2).Value = wsData.Range("C" & m).Resize(, 2).Value
                    n = n + 1
                End If
            Next m
            wsBill.Copy After:=wb.Worksheets(wb.Worksheets.Count)
            With ActiveSheet
                .Range("A2").Value = .Range("A2").Value
                .Range("D1").ClearContents
                For Each shp In .Shapes
                    shp.Delete
                Next shp
            End With
        Next r
        Application.DisplayAlerts = False
            wb.Worksheets(1).Delete
        Application.DisplayAlerts = True
        wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "\Desktop\" & "All_Bills.pdf", OpenAfterPublish:=True
        wb.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub

 

  • Like 3

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

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

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

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

سجل حساب جديد

تسجيل دخول

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

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

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

Important Information