Dim DataArray() As Variant
    Dim i, j, Num As Integer
    
    Screen.MousePointer = vbHourglass
    
    'Start a new workbook in Excel
    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Add
    
    'Create an array
    Num = datPrimaryRS.Recordset.RecordCount
    If Num = 0 Then
      MsgBox "發排數據為空。", vbInformation
      Exit Sub
    End If
    ReDim DataArray(1 To Num, 1 To 10) As Variant
    
    datPrimaryRS.Recordset.MoveFirst
    For i = 1 To Num
        For j = 1 To 10
            DataArray(i, j) = datPrimaryRS.Recordset.Fields(j - 1).Value
        Next
        datPrimaryRS.Recordset.MoveNext
    Next
    datPrimaryRS.Recordset.MoveFirst
    
    'Add headers to the worksheet on row 1
    Set oSheet = oBook.Worksheets(1)
    oSheet.Range("A1:J1").Select
    With oExcel.Selection
        .HorizontalAlignment = -4108
        .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    oSheet.Range("A1").Value = Format(Now(), "yyyy") & "年外文圖書總帳"
    oSheet.Range("A2").Value = "總號"
    oSheet.Range("B2").Value = "分類"
    oSheet.Range("C2").Value = "書名"
    oSheet.Range("D2").Value = "作者"
    oSheet.Range("E2").Value = "出版單位"
    oSheet.Range("F2").Value = "單價"
    oSheet.Range("G2").Value = "冊數"
    oSheet.Range("H2").Value = "出版日期"
    oSheet.Range("I2").Value = "登記日期"
    oSheet.Range("J2").Value = "備注"
    oSheet.Range("A2:J2").Select
    With oExcel.Selection
        .HorizontalAlignment = -4108
        .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
    End With
    
    'Transfer the array to the worksheet starting at cell A2
    oSheet.Range("A3").Resize(Num, 10).Value = DataArray
    
    oSheet.Range("A2:J" & CStr(Num + 2)).Select
    oExcel.Selection.Borders(5).LineStyle = -4142
    oExcel.Selection.Borders(6).LineStyle = -4142
    With oExcel.Selection.Borders(7)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(8)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(9)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(10)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(11)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(12)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    
    oSheet.Range("E" & CStr(Num + 3)).Value = "合計"
    oSheet.Range("F" & CStr(Num + 3)).Formula = "=SUM(F3:F" & CStr(Num + 2) & ")"
    oSheet.Range("G" & CStr(Num + 3)).Formula = "=SUM(G3:G" & CStr(Num + 2) & ")"

    
    oSheet.Columns("A:A").EntireColumn.AutoFit
    oSheet.Columns("B:B").EntireColumn.AutoFit
    oSheet.Columns("C:C").EntireColumn.AutoFit
    oSheet.Columns("D:D").EntireColumn.AutoFit
    oSheet.Columns("E:E").EntireColumn.AutoFit
    oSheet.Columns("F:F").EntireColumn.AutoFit
    oSheet.Columns("G:G").EntireColumn.AutoFit
    oSheet.Columns("H:H").EntireColumn.AutoFit
    oSheet.Columns("I:I").EntireColumn.AutoFit
    oSheet.Columns("J:J").EntireColumn.AutoFit
    
    
    With oSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    oSheet.PageSetup.PrintArea = ""
    With oSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = oExcel.InchesToPoints(0.75)
        .RightMargin = oExcel.InchesToPoints(0.75)
        .TopMargin = oExcel.InchesToPoints(1)
        .BottomMargin = oExcel.InchesToPoints(1)
        .HeaderMargin = oExcel.InchesToPoints(0.5)
        .FooterMargin = oExcel.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = -4142
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = 2
        .Draft = False
        .PaperSize = 12
        .FirstPageNumber = -4105
        .Order = 1
        .BlackAndWhite = False
        .Zoom = 100
    End With
       
    oSheet.Range("A1").Select

    oExcel.Visible = True
    
    Screen.MousePointer = vbDefault
    
    Set oExcel = Nothing
    Set oBook = Nothing
    Set oSheet = Nothing
End Sub

Private Sub cmdPrint1_Click()
    Dim strSQL As String
    Dim oWrd As Object
    
    Set oWrd = CreateObject("Word.Application")
    oWrd.Visible = True
    oWrd.Activate
    oWrd.Documents.Add

    With oWrd.ActiveDocument.PageSetup
        .TopMargin = 24
        .BottomMargin = 72
        .LeftMargin = 50
        .RightMargin = 361
        .PageWidth = 595.3
        .PageHeight = 841.9
    End With
    
    With oWrd.Selection
      
      With .ParagraphFormat
            .Alignment = 3
            .LineSpacingRule = 1
            .SpaceBefore = 0
            .SpaceAfter = 0
      End With
      
      .Font.Name = "宋體"
      .Font.Bold = True
      .Font.Size = 12
      .TypeText "圖" & Format(txtFields(1).Text, "00000")
      .TypeParagraph
      
      .Font.Size = 10.5
      .Font.Bold = True
      
      With .ParagraphFormat
            .Alignment = 3
            .LineSpacingRule = 0
            .SpaceBefore = 0
            .SpaceAfter = 0
      End With

      .TypeText txtFields(3).Text
      .TypeParagraph
      .TypeText txtFields(0).Text
      .TypeParagraph
      
      .HomeKey unit:=6

    End With

    Set oWrd = Nothing
    

End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '錯誤處理程序代碼置于此處
  '想要忽略錯誤，注釋掉下一行
  '想要捕獲它們，在此添加代碼以處理它們
  MsgBox "Data error event hit err:" & Description
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  datPrimaryRS.Recordset.AddNew

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
'  On Error GoTo DeleteErr
'  With datPrimaryRS.Recordset
'    .Delete
'    .MoveNext
'    If .EOF Then .MoveLast
'  End With
'  Exit Sub
'DeleteErr:
'  MsgBox Err.Description

  Dim lgNum As Long
  
  On Error GoTo DeleteErr
    Dim nYN As Byte
    
     nYN = MsgBox("您正準備刪除當前記錄。" & Chr(13) & Chr(13) & _
        "假如您單擊“是”，您將不能撤消這個刪除操作。" & Chr(13) & _
        "您確認刪除這條記錄嗎?", vbExclamation + vbYesNo)
    
    If nYN = vbYes Then
      
      lgNum = datPrimaryRS.Recordset.AbsolutePosition
    
      cn.Execute " delete from 外文圖書 where 圖書id =" & txtFields(1).Text
      
      datPrimaryRS.Refresh
      datPrimaryRS.Recordset.AbsolutePosition = lgNum
      If datPrimaryRS.Recordset.EOF Then datPrimaryRS.Recordset.MoveLast
      
    End If
    
  Exit Sub
DeleteErr:
  MsgBox Err.Description


End Sub

Private Sub cmdRefresh_Click()
  '只有多用戶應用程序需要
  On Error GoTo RefreshErr
  datPrimaryRS.Refresh
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  datPrimaryRS.Recordset.UpdateBatch adAffectAll
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub


Private Sub UserDocument_Initialize()
'    With datPrimaryRS
'        .ConnectionString = pConn
'        .RecordSource = "select 圖書ID, 分類ID, 書名, 作者, 出版單位, 單價, 冊數, 出版日期, 登記日期, 備注, 頁數, 譯名, 文種id from 外文圖書 ORDER BY 圖書ID;"
'        .Refresh
'    End With
    
    
    Dim strSQL As String
    
    cn.Open pConn
    
    
    strSQL = "select 圖書ID, 分類, 書名, 作者, 出版單位, 單價, 冊數, 出版日期, 登記日期, 備注, 頁數, 譯名, 外文圖書.分類ID, 文種id " & _
      "FROM 外文圖書 INNER JOIN 圖書分類 ON 外文圖書.分類ID = 圖書分類.分類ID " & _
      " ORDER BY 圖書ID;"
    
    With rs
        .ActiveConnection = cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open strSQL
    End With
    
    Set datPrimaryRS.Recordset = rs
    
    With Adodc1
        .ConnectionString = pConn
        .RecordSource = "圖書分類"
        .Refresh
    End With

    With Adodc2
        .ConnectionString = pConn
        .RecordSource = "文種"
        .Refresh
    End With
    
    With DataCombo1
        Set .DataSource = datPrimaryRS
        .DataField = "分類id"
        Set .RowSource = Adodc1
        .ListField = "分類"
        .BoundColumn = "分類id"
    End With

End Sub

Private Sub UserDocument_Show()
'    datPrimaryRS.Refresh
End Sub

Private Sub UserDocument_Terminate()
    rs.Close
    cn.Close
    
End Sub