经验首页 前端设计 程序设计 Java相关 移动开发 数据库/运维 软件/图像 大数据/云计算 其他经验
当前位置:技术经验 » 程序设计 » VB.Net » 查看文章
effective VBA
来源:cnblogs  作者:儒雅随和的小郭  时间:2019/3/6 9:15:33  对本文有异议

For Append As:

Open "1.txt" For Append As #1
Open "1.txt"就是打开名为1.txt的文件
For Append就是追加的意思,也就是在原有文件内容的后面增加新的内容
As #1是把打开的文件标识为一个句柄#1,用于后面的代码对这个文件进读写行操作,

比如print #1, "1234"

打开word文档:

Sub test()
    Dim DocApp As Object
    Set DocApp = CreateObject("Word.Application")
    DocApp.Visible = True
    DocApp.Documents.Open Filename:="D:\abc\123.doc"
End Sub

 

 

遍历目标文件下所有指定文件(包括子文件夹):

    Dim MyName, Dic, Did, i, T, F, TT, MyFileName
    T = Time
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Did = CreateObject("Scripting.Dictionary")
    Dic.Add ("C:\Users\AA\BB\CC\"), ""
    i = 0
    Do While i < Dic.count
        Ke = Dic.keys
        MyName = Dir(Ke(i), vbDirectory)
        Do While MyName <> ""
            If MyName <> "." And MyName <> ".." Then
                If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then
                    Dic.Add (Ke(i) & MyName & "\"), ""
                End If
            End If
            MyName = Dir
        Loop
        i = i + 1
    Loop
    For Each Ke In Dic.keys
        MyFileName = Dir(Ke & "*.odt")
        Do While MyFileName <> ""
            Did.Add (Ke & MyFileName), ""
            MyFileName = Dir
        Loop
    Next
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = "XXX" Then
            Sheets("XXX").Cells.Delete
            F = True
            Exit For
        Else
            F = False
        End If
    Next
    If Not F Then
        Sheets.Add.Name = "XXX"
    End If
    Sheets("XXX").[a1].Resize(Did.count, 1) = WorksheetFunction.Transpose(Did.keys)

 

通过excel vba 操作word页眉:

Sub replace_odt(replaceParam As String, odtPath As Variant)
    'replace xxx.doc/odt with data collected from input_format_update.xlsx
    Dim Wdapp, Wd
    Application.ScreenUpdating = False
    Set Wdapp = CreateObject("word.application")
    Set Wd = Wdapp.Documents.Open(odtPath)
    Wdapp.Visible = False
  
    Wdapp.Selection.Find.ClearFormatting
        Wdapp.Selection.Find.replacement.ClearFormatting
        With Wdapp.Selection.Find
                .Text = replaceParam 'need to be replaced
                .replacement.Text = "[NAME]" ' want to replace with
                .Forward = True
                .Wrap = 1
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
        End With
        Wdapp.Selection.Find.Execute replace:=2
   
    Wd.SaveAs odtPath
    Wd.Close
    Wdapp.Quit
   
    Set Wd = Nothing
    Set Wdapp = Nothing
    Application.ScreenUpdating = True
End Sub
 
上面操作word的时候相当于通过以下代码创造一个word vba 环境
(word vba 代码前面加 wdapp.)
Set Wdapp = CreateObject("word.application")
    Set Wd = Wdapp.Documents.Open(odtPath)
    Wdapp.Visible = False
  
    Wdapp.Selection.Find.ClearFormatting
        Wdapp.Selection.Find.replacement.ClearFormatting
        With Wdapp.Selection.Find
 
on error:
 
On Error Resume Next:
写在最前面,如果sub中出现异常/错误,程序会继续执行,不会停
On Error GoTo ErrorFlag:
与下面代码一起食用,在喜欢的地方放置,如果出现异常/错误,就会触发XXX
ErrorFlag:
  XXX(定义好的function)
Exit Sub
 
 
清空sheet:
Worksheets("XXX").UsedRange.ClearContents
 

原文链接:http://www.cnblogs.com/guojia314/p/10475016.html

 友情链接: NPS  问卷模板