vba-事务+提取所有公式

Sub accTrans()

    Dim Conn As New ADODB.Connection
    'Conn.Open ".......连接你的Acc数据库.........."
   
    On Error GoTo ErrHndl:
   
    Conn.BeginTrans    '事务开始
    Sql = "update a set num=1000 where id=24"    '第一个sql语句为update。（语法正确）
    Conn.Execute (Sql)
    Sql = "insert into a(num) values('a')"    '第二个sql语句为错误的sql语句
    Conn.Execute (Sql)
    Sql = "insert into a(num) values(33333)"    '第三个sql语句为正确的sql语句
    Conn.Execute (Sql)
   
ErrHndl:
    If Conn.Errors.Count = 0 And Err.Number = 0 Then
        Conn.CommitTrans  '如果没有conn错误，则执行事务提交
    Else
        Conn.RollbackTrans    '否则回滚
    End If

End Sub

 

'功能：提取EXCEl中的所有公式
'---------------------------------------------------
Sub getAllFormula()
  Dim allFormulaRng As Range, fmRng As Range
  Dim sht As Worksheet
  Dim arFormula(1 To 100000, 1 To 4)
  Dim n As Long
  For Each sht In ThisWorkbook.Worksheets
    On Error Resume Next
    '已使用区域中定位公式
    Set allFormulaRng = sht.UsedRange.SpecialCells(xlCellTypeFormulas)
    If Err = 0 Then
        If Not allFormulaRng Is Nothing Then
            For Each fmRng In allFormulaRng
                n = n + 1
                With sht
                    arFormula(n, 1) = n - 1 '序号
                    arFormula(n, 2) = sht.Name '表名
                    arFormula(n, 3) = fmRng.Address(0, 0) '地址
                    arFormula(n, 4) = fmRng.Formula '公式
                End With
            Next
        End If
    Else
        '无公式，打印表名和错误说明
        Debug.Print sht.Name & "_" & Err.Description
        Err.Clear
    End If
  Next
  '写入结果
  With Sheets("公式")
        .Cells.Clear
        With .Columns("A:F")
            .Font.Size = 11
            .Font.Name = "Microsoft YaHei UI"
            .HorizontalAlignment = xlLeft
            .NumberFormatLocal = "@"
        End With
        .[A1].Resize(1, 4) = Array("序号", "表名", "地址", "公式")
        .[A2].Resize(n, 4) = arFormula
        .Columns("A:F").AutoFit
  End With
End Sub