<output id="os3gq"><ruby id="os3gq"></ruby></output>

    1. <mark id="os3gq"></mark>
    2. access使用excel代碼-螢火蟲
      Access軟件網QQ交流學習群(群號碼198465573),歡迎您的加入!
      首頁 >技術文章> Access數據庫-模塊/函數/VBA


      access使用excel代碼

      發表時間:2018/6/25 20:56:24 評論(0) 瀏覽(3809)  評論 | 加入收藏 | 復制
         
      摘 要:非洲避暑
      正 文:
      excel自動化操作常使用錄制宏功能,自動生成操作代碼,

      在access環境中使用,需修改對象的前綴名,參照如下。


      引用前期綁定
      引用Microsoft Excel XX object Library
      引用Microsoft ActiveX Date Objects 2.8
      Private Sub cmd_啟動_Click()
          Dim MyRecordset As New ADODB.Recordset
          Dim cnnDB As New ADODB.Connection
          Dim strSQL As String
          Dim xlApp As New Excel.Application
          Dim xlWbk As Excel.Workbook
          Dim xlsheet As Excel.Worksheet
          Dim c As Integer
          Dim b As Integer
          Set xlWbk = xlApp.workbooks.Add
          xlApp.Visible = True
          Set cnnDB = CurrentProject.Connection
          strSQL = "Select 付款日期, 承運商, 車牌號, 未付金額, 備注 FROM 表1"
          MyRecordset.Open strSQL, cnnDB
          Set xlsheet = xlWbk.Worksheets.Add
          xlsheet.Name = "原始信息"
          With xlsheet
          xlApp.Range("A2").CopyFromRecordset MyRecordset
          End With
          c = 1
          For b = 0 To MyRecordset.Fields.Count - 1
          xlApp.Activesheet.Cells(1, c).Value = MyRecordset.Fields(b).Name
          c = c + 1
          Next b
          Set xlsheet = xlWbk.Worksheets.Add
          xlsheet.Name = "處理結果"
        xlApp.Application.ScreenUpdating = False
        xlWbk.Sheets("處理結果").Activate
        Dim d, arr, key, i, j, k, m, n
        Set d = CreateObject("Scripting.Dictionary")
        arr = xlWbk.Sheets("原始信息").[A1].CurrentRegion.Value
        m = UBound(arr): n = UBound(arr, 2)
        For i = 2 To m
          d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 4)
        Next
        ReDim brr(1 To m + d.Count, 1 To n)
        For Each key In d.keys
          For i = 2 To m
            If arr(i, 2) = key Then
              k = k + 1
              For j = 1 To n
                brr(k, j) = arr(i, j)
              Next
            End If
          Next
          k = k + 1
          brr(k, 2) = "小計": brr(k, 4) = d(key)
        Next
        k = k + 1
        brr(k, 2) = "合計": brr(k, 4) = xlApp.Application.Sum(d.items)
        With Range("A1")
          .CurrentRegion.Borders.LineStyle = 0
          .CurrentRegion.ClearContents
          .Resize(1, n) = xlApp.Application.Index(arr, 1, 0)
          .Offset(1).Resize(k, n) = brr
          .CurrentRegion.Borders.LineStyle = 1
        End With
        Range("A1:E100").Columns.AutoFit
        Range("A" & Rows.Count).End(xlUp).Offset(3, 0) = "時間:" & Format(Now(), "YYYY-MM-DD") & "        " & "制表人:***" & "        " & "審核人:***"
        xlApp.Application.DisplayAlerts = False
        xlWbk.Sheets("原始信息").Delete
        xlWbk.Sheets("sheet1").Delete
        xlWbk.Sheets("sheet2").Delete
        xlWbk.Sheets("sheet3").Delete
        xlApp.Application.ScreenUpdating = True
          ChDir "C:\Users\Administrator\Desktop"
          xlApp.ActiveWorkbook.SaveAs FileName:="C:\Users\Administrator\Desktop\報表.xlsx", _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
          xlApp.Rows("1:1").Select
          xlApp.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          xlApp.Rows("1:1").Select
          xlApp.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          xlApp.Range("A1:E1").Select
          With xlApp.Selection
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter
              .WrapText = False
              .Orientation = 0
              .AddIndent = False
              .IndentLevel = 0
              .ShrinkToFit = False
              .ReadingOrder = xlContext
              .MergeCells = False
          End With
          xlApp.Selection.Merge
          xlApp.Range("A1:E1").Select
          xlApp.ActiveCell.FormulaR1C1 = "供應商報表"
          xlApp.Range("A1:E1").Select
          With xlApp.Selection.Font
              .Name = "宋體"
              .Size = 16
              .Strikethrough = False
              .Superscript = False
              .Subscript = False
              .OutlineFont = False
              .Shadow = False
              .Underline = xlUnderlineStyleNone
              .ThemeColor = xlThemeColorLight1
              .TintAndShade = 0
              .ThemeFont = xlThemeFontMinor
          End With
          xlApp.Selection.Font.Bold = True
          xlApp.Range("A2").Select
          xlApp.ActiveCell.FormulaR1C1 = "從" & Format(Now() - 30, "YYYY-MM-DD") & "到" & Format(Now(), "YYYY-MM-DD")
          xlApp.Range("A4:A100").Select
          xlApp.Selection.NumberFormatLocal = "yyyy/m/d"
          Set MyRecordset = Nothing
          Set xl = Nothing
          Set xlwkbk = Nothing
          Set xlsheet = Nothing
      End Sub



      Access軟件網交流QQ群(群號:198465573)
       
       相關文章
      [張志MVP]從Excel到Access數據庫視頻課程  【張志  2018/4/5】
      【Excel InsertSpace函數示例】增加字符間空格,輸入...  【麥田  2018/5/29】
      excel表間sql語句運算  【螢火蟲  2018/6/8】
      excel與spl server遠程交互  【螢火蟲  2018/6/8】
      Access與Excel結合運用視頻教程  【張志  2020/4/10】
       
       訪客評論
      總記錄:0篇  頁次:0/0 9 1 :
       
       發表評論
      評論內容 (必填)

      常見問答
      技術分類
      相關資源
      文章搜索
      關于作者

      螢火蟲

      文章分類

      文章存檔

      友情鏈接
       
         
      湖北11选5