تصدير من اكسس الى ملف اكسل مجهز مسبقا وحفظ ملف جديد باسم جديد

[بن شجاع الدين]

سلام عليكم وشهر مبارك على الجميع.

 

احتاج الى ما تعودت عليه من كرمكم  ودعمكم ,

حاولت ان اجد ما اريد في المنتدى ولاكن لم اوفق,

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

وذالك عند النقر على زر امر كما في الملف المرفق

Export to excel temp.rar

[بن شجاع الدين]

سلام عليكم

هل من مجيب؟

[بن شجاع الدين]

سلام عليكم

وما زلت أأمل ان يجيب على تساؤلي احد الأخوة

[jjafferr]

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

 

تفضل :

Private Sub cmd_Export_to_Excel_Click()

    Dim xlApp As Object  'Excel.Application
    Dim xlWB As Object   'Excel.Workbook
    Dim rst As DAO.Recordset
    
    'open excel template
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False   'True
    Set xlWB = xlApp.Workbooks.Open(CurrentProject.Path & "\Excel Destn Temp.xltx")
    Set xlWS = xlWB.Worksheets(1)


    'Expense report Number
    xlWS.Cells(4, 3).Value = Me.[Expense report Number]
    xlWS.Cells(4, 3).Font.Bold = True
    xlWS.Cells(4, 3).Interior.Color = vbRed
        
    'Employee Code
    xlWS.Cells(6, 3).Value = Me.[Employee Code]
    xlWS.Cells(6, 3).Font.Bold = True
    xlWS.Cells(6, 3).Interior.Color = vbRed
    
    'Employee Name
    xlWS.Cells(7, 3).Value = Me.[Employee Name]
    xlWS.Cells(7, 3).Font.Bold = True
    xlWS.Cells(7, 3).Interior.Color = vbRed
    
        
        
    'the subform values
    Set rst = Me.Vouchers_Subform.Form.RecordsetClone
    rst.MoveLast: rst.MoveFirst
    RC = rst.RecordCount
    
    iRow = 10 'i + 1
    For i = 1 To RC
    
        'Sequence
        xlWS.Cells(iRow + i, 1).Value = i
        xlWS.Cells(iRow + i, 1).Font.Bold = True
        xlWS.Cells(iRow + i, 1).Interior.Color = vbRed
    
        'VDate
        xlWS.Cells(iRow + i, 2).Value = rst!VDate
        xlWS.Cells(iRow + i, 2).Font.Bold = True
        xlWS.Cells(iRow + i, 2).Interior.Color = vbRed
        
        'Expense Type
        xlWS.Cells(iRow + i, 3).Value = "jj"
        xlWS.Cells(iRow + i, 3).Font.Bold = True
        xlWS.Cells(iRow + i, 3).Interior.Color = vbRed
        
        'Voucher NUMBER
        xlWS.Cells(iRow + i, 4).Value = rst!VoucherNUMBER
        xlWS.Cells(iRow + i, 4).Font.Bold = True
        xlWS.Cells(iRow + i, 4).Interior.Color = vbRed
        
        'VA mount
        xlWS.Cells(iRow + i, 6).Value = rst!VAmount
        xlWS.Cells(iRow + i, 6).Font.Bold = True
        xlWS.Cells(iRow + i, 6).Interior.Color = vbRed

        rst.MoveNext
    Next i
            
    xlApp.Save  'ask the user to save the new file
    xlApp.Quit

    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
            
End Sub

 

جعفر

677.Export to excel temp.zip

[بن شجاع الدين]

شكرا اخي Jaffer

ولاكن عند النقر على ور امر التصدير الى اكسل تضهر لي هذه الرسالة فما هو السبب لو تكرمنم

Error MSG.rar

[صالح حمادي]

السلام عليكم

في ١٥‏/٧‏/٢٠١٧ at 15:06, jjafferr said:

xlApp.Save 'ask the user to save the new file

كيف يمكن تعويض هذا السطر بمسار الحفظ لا أريد ظهور مربع الحوار و اختيار مكان الحفظ.

[صالح حمادي]

لقد وجدت الحل بواسطة هذا الكود:

curPath="f:\"
xlWB.SaveAs FileName:=curPath, CreateBackup:=False

 

[Shivan Rekany]

تقدر تستخدم هذا ايضا

    xlWB.SaveAs "D:\Excel Destn Temp" & Format(Now, "YYYYMMDDHHNNSS") & ".xlsx"

تم تعديل نوفمبر 10, 2018 بواسطه Shivan Rekany