VBA笔记系列

整表复制粘贴-->清空内存

Sheet1.Copy after:=Sheet1

Application.CutCopyMode = False

新建sheet

Sheets.Add After:=Worksheets(sheet_start)

字典：

Set d = CreateObject("Scripting.Dictionary")

d.removeall ''''清空字典

If d.Exists(arr(x, 1)) Then  '''判断键是否已经存在

数组整体粘贴：

Range("a1").Resize(行，列) = 数组名

VBA遍历文件夹

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(path)

For Each fd In f.Files
For Each fd In f.subfolders

关闭警告

关闭警告(包括替换同名文件，含有个人信息等)
Application.DisplayAlerts = False
Application.ScreenUpdating = False

闭除本文件外的所有excel：

if Workbooks.Count > 1 then
    For x = Workbooks.Count To 1 Step -1
        wb = Windows(x).Caption
        If wb <> ThisWorkbook.Name Then
            Workbooks(wb).Close False
        End If
    Next
end if

排序:

Range(Cells(321, c_to), Cells(i, c_to)).Sort _
    key1:=Columns(c_to), _
    Order1:=xlDescending, _
    Header:=xlNo

数组赋值

arr=Sheet3.Range("D7:D9")

32位变64位  申明：

declare PtrSafe sub

PPT页面内容读取

Set f = ThisWorkbook.Sheets(2)
f.Cells(1, 1) = "页码"
f.Cells(1, 2) = "顺序"
f.Cells(1, 3) = "类型"
f.Cells(1, 4) = "内容"
i = 2
j = 1
c = ppt.Presentations(1).Slides.Count
For c2 = 1 To c
    Set s1 = ppt.Presentations(1).Slides(c2)
    f.Cells(i, 1) = j
    j = j + 1
    k = 1
    For Each sh In s1.Shapes
        f.Cells(i, 2) = k
        f.Cells(i, 3) = sh.Type
        f.Cells(i, 6) = sh.Name


        If sh.HasTextFrame Then
'            f.Cells(i, 4) = sh.TextEffect.Text
        End If

        If sh.HasTable Then
            f.Cells(i, 5) = sh.Table.Columns.Count
            f.Cells(i, 4) = sh.Table.Rows.Count
        End If

        If sh.Type = 3 Then
'            f.Cells(i, 4) = sh.Chart.ChartData.Workbook.Sheets(1).Columns.Count
        End If

        i = i + 1
        k = k + 1
    Next
Next
ppt.Quit
End Sub