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

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


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

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

 

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

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

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

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

Export to excel temp.rar

رابط هذا التعليق
شارك

  • 2 weeks later...
  • 1 month later...

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

 

تفضل :

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

  • Like 3
رابط هذا التعليق
شارك

  • 3 weeks later...
  • 1 year later...

السلام عليكم

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

xlApp.Save 'ask the user to save the new 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.

×
×
  • اضف...

Important Information