ก็มีอีกเช่นเดิมแหละค่ะ
ใช้ object ของ excel
แล้วใช้ object ตามวิถีของ excel

ลองค้นหัวข้อ VBA excel นะคะ
จะได้รู้วิธีอ้างถึง cell / column ยังไง
รวมถึง การเปิด ปิด สร้าง ด้วยนะคะ

โชคดีค๊า

ให้ข้อมูล sub form ไปพักที่ table สิครับ แค่นี้ก็จะ export ไป Excel ได้แล้วครับ คือปรกติผมจะใช้ วิที่ไปทิ้งไว้ที่ Table ก่อนแล้ว ใส่คำสั่ง vba ลงไปให้ไปหาชื่อ ก่อนว่ามีอะไรบ้าง อยู่ colume ไหน แล้วก็ make Table ให้เป็นฟอร์มเดียวกะที่เราต้องการ แล้ว Export excel ธรรมดา ค่อย เปิดจากที่ export ไปใส่ temp รูปแบบ excel ที่เราสร้างไว้ครับ
ตัวอย่างนะครับ

Option Compare Database
Dim Re_name
Function ExpXls(Rpt_id As String)
DoCmd.SetWarnings False

Shell ("D:\SaleQuatration_Model\DeleteReport.bat")
    On Error Resume Next
    Dim rsAS_OF As New ADODB.Recordset
    Dim DataMonth As String
    DataMonth = ""
    If rsAS_OF.State = adStateOpen Then rsAS_OF.Close
    With rsAS_OF
      .ActiveConnection = CurrentProject.Connection
      .CursorType = adOpenKeyset
      .Source = "SELECT Max([YR_MNTH]) AS Mnth FROM POINT_BR"
      .LockType = adLockPessimistic
      .Open
    End With
    
    
    Select Case Val(Right(rsAS_OF!Mnth, 2))
        Case 1
            DataMonth = "ม.ค. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 2
            DataMonth = "ก.พ. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 3
            DataMonth = "มี.ค. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 4
            DataMonth = "เม.ย. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 5
            DataMonth = "พ.ค. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 6
            DataMonth = "มิ.ย. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 7
            DataMonth = "ก.ค. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 8
            DataMonth = "ส.ค. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 9
            DataMonth = "ก.ย. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 10
            DataMonth = "ต.ค. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 11
            DataMonth = "พ.ย. " & Left(rsAS_OF!Mnth, 4) + 543
        Case 12
            DataMonth = "ธ.ค. " & Left(rsAS_OF!Mnth, 4) + 543
    End Select
    On Error GoTo 0
    
    
    
'Function ExpXls()
    'Rpt_id = "RPT1"
    'XLS_REPORT
    Dim rstXls As New ADODB.Recordset
    If rstXls.State = adStateOpen Then rstXls.Close
    With rstXls
      .ActiveConnection = CurrentProject.Connection
      .CursorType = adOpenKeyset
      .Source = "SELECT * FROM XLS_REPORT WHERE REPORT_ID = '" & Rpt_id & "' "
      .LockType = adLockPessimistic
      .Open
    End With
    If rstXls.RecordCount < 1 Then
        MsgBox "ไม่พบ report_id"
        Exit Function
    End If
    'XLS_SHEET
    Dim rstSheet As New ADODB.Recordset
    If rstSheet.State = adStateOpen Then rstSheet.Close
    With rstSheet
      .ActiveConnection = CurrentProject.Connection
      .CursorType = adOpenKeyset
      .Source = "SELECT * FROM XLS_SHEET WHERE REPORT_ID = '" & Rpt_id & "' "
      .LockType = adLockPessimistic
      .Open
    End With
    If rstSheet.RecordCount < 1 Then
        MsgBox "ไม่พบ report_id"
        Exit Function
    End If
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
'    On Error Resume Next
'    Kill CurrentProject.Path & "\" & rstXls!report_name & ".xls"
'    If Err.Number = 70 Then
'        MsgBox "Err : file '" & rstXls!report_name & ".xls' "
'        Exit Function
'    End If
'    On Error GoTo 0
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
'    On Error Resume Next
'    Kill CurrentProject.Path & "\" & rstSheet!Source & ".xls"
'    If Err.Number = 70 Then
'        MsgBox "Err : file 'temp" & rstSheet!Source & ".xls' "
'        Exit Function
'    End If
'    On Error GoTo 0
'    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, rstSheet!Source, CurrentProject.Path & "\" & rstSheet!Source & ".xls"
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlApp2 As Excel.Application
    Dim xlBook2 As Excel.Workbook
    Dim xlSheet2 As Excel.Worksheet

   


    Set xlApp = CreateObject("Excel.Application")
    'Set gapp = CreateObject("AcroExch.app")
    'Set avDoc = CreateObject("AcroExch.AVDoc")
    'Set xlBook = xlApp.Workbooks.Open(fname)
    Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\Template\" & rstXls!template_name & ".xlt")
    
    Dim xlCalc As XlCalculation
    xlCalc = xlApp.Application.Calculation
    xlApp.Application.Calculation = xlCalculationManual
    'xlApp.Application.Calculation = xlCalculationAutomatic
    
    
Do While Not rstSheet.EOF
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
    On Error Resume Next
    Kill CurrentProject.Path & "\" & rstSheet!Source & ".xls"
    If Err.Number = 70 Then
        MsgBox "Err : file " & rstSheet!Source & ".xls' "
        Exit Function
    End If
    On Error GoTo 0
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, rstSheet!Source, CurrentProject.Path & "\" & rstSheet!Source & ".xls"
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
    'rst
    Dim rst As New ADODB.Recordset
    If rst.State = adStateOpen Then rst.Close
    With rst
      .ActiveConnection = CurrentProject.Connection
      .CursorType = adOpenKeyset
      .Source = "SELECT * FROM " & rstSheet!Source
      .LockType = adLockPessimistic
      .Open
    End With
    
    Set xlSheet = xlBook.Worksheets("" & rstSheet!sheet_name)
    For i = 1 To 6
        'DataMonth
        If xlSheet.Cells(i, 1) = "เดือน" Then
            xlSheet.Cells(i, 2) = DataMonth
        End If
    Next i
    
    
    xlApp.Visible = True 'x x x x x x x x x x x x x x x x x x'
    
    'DoCmd.RunMacro "macro3"
    xlSheet.Rows(11 & ":" & rst.RecordCount + 11 - 3).Insert Shift:=xlDown
    xlBook.Sheets("" & rstSheet!sheet_name).Select
    xlSheet.Range("A1").Select
    
    
    
    Set xlApp2 = CreateObject("Excel.Application")
    'Set xlBook2 = xlApp2.Workbooks.Open(fname)
    Set xlBook2 = xlApp2.Workbooks.Open(CurrentProject.Path & "\" & rstSheet!Source & ".xls")
    Set xlSheet2 = xlBook2.Worksheets("" & rstSheet!Source)
    'xlApp2.Visible = True
    'DoCmd.RunMacro "macro3"
    
    'xlSheet2.Range("A1").Select
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
    col_xls1 = 1
    Do While Len(xlSheet.Cells(7, col_xls1)) > 0
        If Len(xlSheet.Cells(8, col_xls1)) = 0 Then
            'xlSheet.Range(xlSheet.Cells(9, col_xls1).AddressLocal & ":" & xlSheet.Cells(9, col_xls1).AddressLocal).Copy
            'xlSheet.Cells(11, rst.RecordCount).PasteSpecial xlPasteFormulas
            
            xlSheet.Range(xlSheet.Cells(9, col_xls1).AddressLocal & ":" & xlSheet.Cells(9, col_xls1).AddressLocal).Copy
            xlSheet.Range(xlSheet.Cells(11, col_xls1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, col_xls1).AddressLocal).PasteSpecial xlPasteFormulas
            
        End If
        col_xls1 = col_xls1 + 1
    Loop

max_col = col_xls1 - 1
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
    col_xls2 = 1
    
    Do While Len(xlSheet2.Cells(1, col_xls2)) > 0
        col_xls1 = 1
        Do While Len(xlSheet.Cells(7, col_xls1)) > 0
            If UCase(xlSheet2.Cells(1, col_xls2)) = UCase(xlSheet.Cells(8, col_xls1)) Then
               xlSheet2.Range(xlSheet2.Cells(2, col_xls2).AddressLocal & ":" & xlSheet2.Cells(rst.RecordCount + 1, col_xls2).AddressLocal).Copy
               'x = xlSheet.Cells(11, col_xls1).AddressLocal
               'x = Replace(x, "$", "")
               'xlSheet.Range(x).PasteSpecial xlPasteValuesAndNumberFormats
               xlSheet.Cells(11, col_xls1).PasteSpecial xlPasteValues
               'xlSheet.Range(xlSheet.Cells(11, col_xls1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, col_xls1).AddressLocal).NumberFormat = "#,##0.#0"
              
            End If
            col_xls1 = col_xls1 + 1
        Loop
        col_xls2 = col_xls2 + 1
    Loop
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - '
    xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlDiagonalDown).LineStyle = xlNone
    xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlDiagonalUp).LineStyle = xlNone
    With xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(11, 1).AddressLocal & ":" & xlSheet.Cells(10 + rst.RecordCount, max_col).AddressLocal).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - '

'            ActiveSheet.ChartObjects("แผนภูมิ 1").Activate
'    ActiveSheet.ChartObjects("แผนภูมิ 1").Activate
'    ActiveSheet.Shapes("แผนภูมิ 1").ScaleWidth 1.0020833333, msoFalse, _
'        msoScaleFromBottomRight
'    ActiveSheet.Shapes("แผนภูมิ 1").ScaleHeight 1.6551724138, msoFalse, _
'        msoScaleFromTopLeft
'    ActiveSheet.ChartObjects("แผนภูมิ 1").Activate
'    ActiveSheet.Shapes("แผนภูมิ 1").ScaleHeight 1.2048611111, msoFalse, _
'        msoScaleFromTopLeft
    '----------------------------------------------------------
    
    xlSheet.Rows("8:10").Delete Shift:=xlUp
    xlSheet.Range("G5").Select
    
    '---------------------------------------------------------------------------------

    
    
    '---------------------------------------------------------------------------------
'    xlSheet2.Range("A1").Select
    
    'Selection.End(xlToLeft).Select
    
    'xlSheet.Application.Selection.End(xlToLeft).Select
    
    rstSheet.MoveNext
    xlBook2.Save
    Set xlSheet = Nothing

    Set xlBook2 = Nothing
    Set xlSheet2 = Nothing
    xlApp2.Quit
    Set xlApp2 = Nothing
    
Loop
    'xlBook.SaveAs CurrentProject.Path & "\" & rstXls!report_name & "-" & Format(Date, "YYMMDD") & "-" & Format(Time, "hhmmss") & ".xlsx"
    If rstXls!report_name = "Center_Report" Then
    
    xlBook.SaveAs CurrentProject.Path & "\" & rstXls!report_name & ".xlsb", _
        FileFormat:=xlExcel12, CreateBackup:=False
    End If
     If rstXls!report_name <> "Center_Report" Then
    xlBook.SaveAs CurrentProject.Path & "\" & rstXls!report_name & ".xlsx"
    End If
    xlApp.Application.Calculation = xlCalculationAutomatic
    xlApp.ActiveWorkbook.Save
    '----------------------------------------------------------------------------------------------------------------------------
    'Set AcroApp = CreateObject("")
    'Set theForm = CreateObject("AcroExch.PDDoc")
   ' theForm.Open ("C:\temp\sampleForm.pdf")
    xlBook.Sheets("ใบเสนอราคา").Select

       
     ' pdf_nme = xlBook.Sheets("Customer").Range("A8").Value & "_" & xlBook.Sheets("Customer").Range("C8").Value
            'pdf_nme = ActiveWorkbook.Name
     '   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=ActiveWorkbook.Path & "\" & pdf_nme & ".pdf", Quality:= _
     ' xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
     ' OpenAfterPublish:=True
       
     
      ' Set gapp = Nothing
     

    xlApp.Visible = True
      'docmd.OutputTo(ObjectType, ObjectName, OutputFormat, OutputFile, AutoStart, TemplateFile, Encoding, OutputQuality)
       
    'xlApp2.Visible = True
    
    Set xlBook = Nothing
    Set xlSheet = Nothing
    
    xlApp.Quit
    Set xlApp = Nothing

    'AppActivate "Microsoft Excel"
    
    'MsgBox "complete"
    'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_REPORT_VOL", CurrentProject.Path & "\report" & Rpt_id & ".xls"

    
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'

'    n = 1
'    Do While Not rst.EOF
'        rst!RANK_NEW_HIRE_VOL = n
'        rst.MoveNext
'        n = n + 1
'    Loop
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'

End Function
Function Shell_Bat()
'x = CurrentProject.Path
'a = x & "\DeleteFile.bat"
Shell ("D:\SaleQuatration_Model\DeleteFile.bat")
'------------------------------------------------------------------------------dim pdf

End Function

Public Sub make_excel1()
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")

With ExcelSheet.Application
' Make Excel visible through the Application object.
.Visible = True
' Place some text in the first cell of the sheet.

.Columns("B:B").ColumnWidth = 26.17
   .Cells(2, 1).Value = "Name"
   .Cells(2, 2).Value = "date"
   .Cells(2, 3).Value = "time"

   .Cells(3, 1).Value = "AAAA"
   .Cells(3, 2).Value = "27/7/59"
   .Cells(3, 3).Value = "'08.00"

End With
' Save the sheet to C:\test.xls directory.
ExcelSheet.SaveAs "D:\TEST.XLSx"

' Close Excel with the Quit method on the Application object.
'ExcelSheet.Application.Quit

' Release the object variable.
Set ExcelSheet = Nothing

End Sub