VBA 常用语句

1.Excel 连接Access:工程引用前勾选 Microsoft DAO 3.6 Object Library

2.Excel 与 Access建立连接并查询数据:

Set conn = CreateObject("adodb.connection")(建立数据库)

Set rs = CreateObject("adodb.recordset")(建立)

conn.Open "Provider = microsoft.ACE.oledb.12.0; Data Source(驱动) =" & link(连接)

SQL = "select * from [Excel 12.0(驱动);hdr=no(无标题);Database=" & ThisWorkbook.FullName & "].[Adjust$k2:m] as a left join [参数] on (a.f1=[参数].[Topcode]) and (a.f2=[参数].[BOM 版本]) and (a.f3=[参数].[BOM 状态])"

rs.Open SQL, conn

Set yy = conn.Execute(SQL)

3.定义字典

Set d = CreateObject("scripting.dictionary")

4.状态栏显示内容

Application.StatusBar = "☆☆☆☆程序正在运行，请稍后……☆☆☆☆"(显示内容)

Application.StatusBar = ""(还原显示)

5.关闭/开启错误提示

Application.DisplayAlerts = False(关闭错误提示)

Application.DisplayAlerts = True(开启错误提示)

6.获取最后一个非空单元格对应的行和列

r=Range("a:a").Find(What:="*",After:=[a1],searchorder:=xlByRows,SearchDirection:=xlPrevious).Row

[a:a].Find("*", , xlValues, , , xlPrevious).Row

c=Range("1:1").Find(What:="*",After:=[a1],searchorder:=xlByRows,SearchDirection:=xlPrevious).Column

7.设置单元格边框

With Range()(所要设置的区域)

  .Borders(xlEdgeLeft).Weight = xlThin

        .Borders(xlEdgeLeft).ThemeColor = 1

        .Borders(xlEdgeLeft).TintAndShade = -0.499984740745262

        .Borders(xlEdgeTop).Weight = xlThin

        .Borders(xlEdgeTop).ThemeColor = 1

        .Borders(xlEdgeTop).TintAndShade = -0.499984740745262

        .Borders(xlEdgeBottom).Weight = xlThin

        .Borders(xlEdgeBottom).ThemeColor = 1

        .Borders(xlEdgeBottom).TintAndShade = -0.499984740745262

        .Borders(xlEdgeRight).Weight = xlThin

        .Borders(xlEdgeRight).ThemeColor = 1

        .Borders(xlEdgeRight).TintAndShade = -0.499984740745262

        .Borders(xlInsideVertical).Weight = xlThin

        .Borders(xlInsideVertical).ThemeColor = 1

        .Borders(xlInsideVertical).TintAndShade = -0.499984740745262

        .Borders(xlInsideHorizontal).Weight = xlThin

        .Borders(xlInsideHorizontal).ThemeColor = 1

        .Borders(xlInsideHorizontal).TintAndShade = -0.499984740745262

End With

8.设置单元格格式

With Range()(所有设置的区域)

.Interior.Color = RGB(128, 128, 128)(单元格颜色)

.Font.name = "Arial"(字体)

.Font.Size = 9(字号)

.Font.Color = RGB(255, 255, 255)(字体颜色)

.NumberFormatLocal = "0_ ;[红色]-0 "(数字格式)

.Merge(合并单元格)

.HorizontalAlignment = xlCenter(水平居中)

.VerticalAlignment = xlCenter(垂直居中)

End With

9.设置单元格有效性

With Selection.Validation

On Error Resume Next(忽略错误语句)

.Delete(删除原有效性)

.Add Type:=xlValidateList(序列方式), AlertStyle:=xlValidAlertStop(警告方式), Operator:=xlBetween, Formula1:=”选项A,选项B,选项C”(序列的值)

End With

10.打开文件

fname1 = Application.GetOpenFilename("All Files (*.*),*.*")

Workbooks.Open Filename:=fname1

11.提取文件夹中所有文件名

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Range("a2:a1048576").ClearContents

On Error Resume Next

Dim f As String

Dim file() As String

Dim i, k, x

x = 1: i = 1: k = 1

ReDim file(1 To i)

file(1) = Cells(1, 3).Value

Do Until i > k

    f = Dir(file(i), vbDirectory)

        Do Until f = ""

            If InStr(f, ".") = 0 Then

                k = k + 1

                ReDim Preserve file(1 To k)

                file(k) = file(i) & f & "\\"

            End If

            f = Dir

        Loop

    i = i + 1

Loop

For i = 1 To k

    f = Dir(file(i) & "*.*")

    Do Until f = ""

       Range("a" & x + 1) = f

       Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:= _

        'file(i) & f, TextToDisplay:=f(设置超链接)

        x = x + 1

        f = Dir

    Loop

Next

Application.ScreenUpdating = True

End Sub

12.打印设置

With ActiveSheet.PageSetup

    .PrintTitleRows = ""                       '工作表打印标题：顶端标题行(R)

    .PrintTitleColumns = ""                    '工作表打印标题：左端标题列(C)

End With

ActiveSheet.PageSetup.PrintArea = ""            '工作表打印区域(A)

With ActiveSheet.PageSetup

    .LeftHeader = ""                          '自定义页眉：左(L)

    .CenterHeader = ""                        '页眉/自定义页眉：中(C)

    .RightHeader = ""                         '自定义页眉：右(R)

    .LeftFooter = ""                           '自定义页脚：左(L)

    .CenterFooter = "第&P页/共&N页"         '页脚/自定义页脚：中(C)

    .RightFooter = ""                         '自定义页脚：右(R)

    .LeftMargin = Application.InchesToPoints(0.75)  '页边距：左(L)_1.9厘米

    .RightMargin = Application.InchesToPoints(0.75)  '页边距：右(R)_1.9厘米

    .TopMargin = Application.InchesToPoints(1)      '页边距：上(T)_2.5厘米

    .BottomMargin = Application.InchesToPoints(1)   '页边距：下(B)_2.5厘米

    .HeaderMargin = Application.InchesToPoints(0.5)  '页边距：页眉(A)_1.3厘米

    .FooterMargin = Application.InchesToPoints(0.5)   '页边距：页脚(F)_1.3厘米

    .PrintHeadings = False                        '工作表打印：行号列标(L)

    .PrintGridlines = False                        '工作表打印：网格线(G)

    .PrintComments = xlPrintNoComments          '工作表打印批注(M)：无/(工作表末尾) xlPrintSheetEnd/(如同工作表中的显示) 

xlPrintIace.CenterHorizontally = False               '页边距居中方式：水平(Z)

    .CenterVertically = True                      '页边距居中方式：垂直(V)

    .Orientation = xlLandscape                  '页面方向：纵向(T) xlPortrait/ 横向 (L)xlLandscape

    .Draft = False                             '工作表打印：按草稿方式(Q)

    .PaperSize = xlPaperA4                     '页面纸张大小(Z)：A4

    .FirstPageNumber = xlAutomatic             '页面起始页码：自动

    .Order = xlDownThenOver           '工作表打印顺序：先列后行(D)/先行后列(V) xlOverThenDown

    .BlackAndWhite = False             '工作表打印：单色打印(B)

    .Zoom = 100   '页面缩放比例：100%  若选择页面缩放比例，则下面两项没有

    .Zoom = False  '页面缩放比例：未选择   若选择调整页面则此项必为False，且与下面两项一起出现

    .FitToPagesWide = 1   '页面缩放：调整为1页高

    .FitToPagesTall = 1     '页面缩放：调整为1页宽

    .PrintErrors = xlPrintErrorsDisplayed   '工作表打印错误单元格打印为(E)：显示值/<空白> xlPrintErrorsBlank/-- xlPrintErrorsDash/#N/A xlPrintErrorsNA

End With

13．返回第一个大于0的列号

={small(if(D2:AN2>0,column(D2:AN2)),1)}(Excel 函数)

14. 返回最后一个大于0的列号

={large(if(D2:AN2>0,column(D2:AN2)),1)} (Excel 函数)