Office应用程序与VBA应用开发

清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
'向下滚动,可用的引用列表直到你遇到需要对象库。注意在这个对话框,我已经检查了参考词和幻灯片。版本号8指的是97处应用;9通过11指Office 2000,Office 2002和Office 2003。
'在顶部你的程序,你需要声明对象变量的具体应用的自动化。自动化微软其他,你需声明以下变量:
Dim otherApp As Other.Application
Dim otherDoc As Other.DocType
Dim otherSpecificObjects As Other.SpecificObjects
 
Then to open a new instance of Other:
 
Set otherApp = CreateObject("Other.Application")
'或使用现有的实例等:
Set otherApp = GetObject(, "Other.Application")
 
'例1:创建新的对象
'打开一个新的实例,创建一个新文件,做一些东西,保存并关闭文件,并退出幻灯片,你的代码是这样的:
Sub ExcelToNewPowerPoint()
    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
 
    ' Create instance of PowerPoint
    Set PPApp = CreateObject("Powerpoint.Application")
 
    ' For automation to work, PowerPoint must be visible
    ' (alternatively, other extraordinary measures must be taken)
    PPApp.Visible = True
 
    ' Create a presentation
    Set PPPres = PPApp.Presentations.Add
 
    ' Some PowerPoint actions work best in normal slide view
    PPApp.ActiveWindow.ViewType = ppViewSlide
 
    ' Add first slide to presentation
    Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
 
    ''---------------------
    '' Do Some Stuff Here
    ''---------------------
 
    ' Save and close presentation
    With PPPres
        .SaveAs "C:\My Documents\MyPreso.ppt"
        .Close
    End With
 
    ' Quit PowerPoint
    PPApp.Quit
 
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
 
End Sub
 
'例2:使用幻灯片对象
'使用活动的幻灯片在活动简报,你的程序看起来是这样的:
Sub ExcelToExistingPowerPoint()
    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
 
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
 
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
 
    ' Some PowerPoint actions work best in normal slide view
    PPApp.ActiveWindow.ViewType = ppViewSlide
 
    ' Reference active slide
    Set PPSlide = PPPres.Slides _
        (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
 
    ''---------------------
    '' Do Some Stuff Here
    ''---------------------
 
    ' Save the presentation
    PPPres.Save
 
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
 
End Sub
 
'例3:使用幻灯片对象如果它们存在的话
'以下步骤检查活动简报对象。如果发现现有的对象,它使用对象;否则需要创建新的对象。这增加了一个层面的防错的代码(见无误差操作)。
Sub ExcelToExistingPowerPoint()
    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
 
    ' Reference instance of PowerPoint
    On Error Resume Next
    ' Check whether PowerPoint is running
    Set PPApp = GetObject(, "PowerPoint.Application")
    If PPApp Is Nothing Then
        ' PowerPoint is not running, create new instance
        Set PPApp = CreateObject("PowerPoint.Application")
        ' For automation to work, PowerPoint must be visible
        PPApp.Visible = True
    End If
    On Error GoTo 0
 
    ' Reference presentation and slide
    On Error Resume Next
    If PPApp.Windows.Count > 0 Then
        ' There is at least one presentation
        ' Use existing presentation
        Set PPPres = PPApp.ActivePresentation
        ' Use active slide
        Set PPSlide = PPPres.Slides _
            (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    Else
        ' There are no presentations
        ' Create new presentation
        Set PPPres = PPApp.Presentations.Add
        ' Add first slide
        Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
    End If
    On Error GoTo 0
 
    ' Some PowerPoint actions work best in normal slide view
    PPApp.ActiveWindow.ViewType = ppViewSlide
 
    ''---------------------
    '' Do Some Stuff Here
    ''---------------------
 
    ' Save the presentation
    PPPres.Save
 
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
 
End Sub
 
'早期与后期绑定
'大多数的例子在这个页面上使用早期绑定相关联的应用程序运行中的程序与其他应用。为探讨早期和后期绑定,指早期与后期绑定和联系,它提供了更全面的描述。