Question

VBA生成Word文件和PPT文件的代码是？

Answer 1

Dim pptApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation '演示文稿。袭宏
Dim PPSlide As PowerPoint.Slide '幻灯片1。==Slide对象代表幻灯片。
Shell "Regsvr32.exe /u /s " & VBA.Chr(34) & "C:\Program Files\Common Files\System\ado\msado15.dll" & VBA.Chr(34), vbHide '注册：解决实时错误429 activeX 部件不能创建对象：
Set pptApp = CreateObject("Powerpoint.Application") '创建powerpoint对象 ’实时错误 429 Active 不能创建对象
'Set pptApp = New PowerPoint.Application
'pptApp.Activate 'powerpoint对象被激活。
pptApp.Visible = True '使得ppt可见
pptApp.WindowState = PowerPoint.PpWindowState.ppWindowMaximized '最大化powerpoint窗口
' Set PPPres = pptApp.Presentations.Open(App.Path & "\AA.PPT", , , True) '打开选中的PowerPoint文档
Set PPPres = pptApp.Presentations.Add(WithWindow:=True) '添加一个新的演脊唯示文稿，并显示
pptApp.Caption = "MW Interference Check"
PPPres.BuiltInDocumentProperties("Subject") = "ZTE-MW" '主题
PPPres.BuiltInDocumentProperties("Author") = "ZTE-WSQ" '作者 替代了ppPres.Author = "WSQ" '作者名称
'ppPres.BuiltinDocumentProperties.Item("author").Value = "ZE_ZX"
PPPres.BuiltInDocumentProperties("Title") = "111"
PPPres.BuiltInDocumentProperties("Company") = "XiAn ZTE of China" '公司
PPPres.BuiltInDocumentProperties("Comments") = " Use only for ZTE" '备注，6个空格，以便对齐
PPPres.BuiltInDocumentProperties("Keywords") = "Do't copy" '关键字
PPPres.BuiltInDocumentProperties("Template") = "ZE ppt Template" '模板
PPPres.BuiltInDocumentProperties("Revision Number") = "155" '修订版本号
PPPres.BuiltInDocumentProperties("Application Name") = "AntHeightCheck.EXE" '应用程序名
PPPres.BuiltInDocumentProperties("Manager"拍野册) = "ZE" '管理器
PPPres.BuiltInDocumentProperties("Category") = "1 " '类别
PPPres.BuiltInDocumentProperties("Format") = "Good" '演示文稿格式
PPPres.BuiltInDocumentProperties("Creation Date") = "2010-02-28 02:28"
PPPres.BuiltInDocumentProperties("Last Author") = "ZTE WSQ"
PPPres.BuiltInDocumentProperties("Last Print Date") = "2010-09-28 02:28"
PPPres.BuiltInDocumentProperties("Last Save Time") = "2010-09-28 02:28"
PPPres.BuiltInDocumentProperties("Total Editing Time") = "15" '编辑时间总计
PPPres.BuiltInDocumentProperties("Number of Pages") = "3" '页数
PPPres.BuiltInDocumentProperties("Number of Words") = "500" '字数
PPPres.BuiltInDocumentProperties("Number of Characters") = "28"
PPPres.BuiltInDocumentProperties("Security") = "201"
PPPres.BuiltInDocumentProperties("Number of Bytes") = "6060" '字节数
PPPres.BuiltInDocumentProperties("Number of Lines") = "100" '行数
PPPres.BuiltInDocumentProperties("Number of Paragraphs") = "100" '段落数
PPPres.BuiltInDocumentProperties("Number of Slides") = "1999" '幻灯片
PPPres.BuiltInDocumentProperties("Number of Notes") = "505" '备注
PPPres.BuiltInDocumentProperties("Number of Hidden Slides") = "101" '隐藏幻灯片
PPPres.BuiltInDocumentProperties("Number of Multimedia Clips") = "103" '多媒体剪辑
PPPres.BuiltInDocumentProperties("Last Print Date") = "1900-1-1" '必须为日期格式且不能为空，下同
'PPPres.BuiltInDocumentProperties("Hyperlink Base") = "@ZTE.CON.CN"
PPPres.BuiltInDocumentProperties("Number of Characters (with spaces)") = "9999" '字符(空格)数目
'==============以下为第1个幻灯片，首页及其标题===================================
Set PPSlide = PPPres.Slides.Add(PPPres.Slides.Count + 1, PowerPoint.PpSlideLayout.ppLayoutTitleOnly) 'Add a new slide.'添加一个新的幻灯片==只有标题 Layout:=ppLayoutBlank ppLayoutBlank
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Text = "MW Interference Check" 'Add some text.标题文本
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 166
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 105
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 43
PPSlide.Shapes(PPSlide.Shapes.Count).width = 384
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.Name = "宋体"
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.size = 34
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.Bold = True
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.Color = vbRed
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.Shadow = True
PPSlide.Shapes(PPSlide.Shapes.Count).Line.BackColor.RGB = RGB(0, 0, 0)
PPSlide.Shapes(PPSlide.Shapes.Count).Line.ForeColor.RGB = RGB(255, 255, 0)
PPSlide.Shapes(PPSlide.Shapes.Count).Line.Weight = 2
PPSlide.Shapes(PPSlide.Shapes.Count).Fill.BackColor.RGB = RGB(0, 0, 255)
PPSlide.Shapes(PPSlide.Shapes.Count).Fill.ForeColor.RGB = RGB(255, 255, 255)
PPSlide.Shapes(PPSlide.Shapes.Count).Fill.TwoColorGradient msoGradientFromCenter, 1 'PPSlide.Shapes.Range(PPSlide.Shapes.Count).Fill.PresetGradient msoGradientHorizontal, 1, 20 'Range填充==很好
'==============以下为两竖线虚线=============================================
PPSlide.Shapes.AddLine 5, 17, 5, 507
PPSlide.Shapes(PPSlide.Shapes.Count).Line.DashStyle = 2 '1实线2虚线
PPSlide.Shapes(PPSlide.Shapes.Count).Line.Weight = 10
PPSlide.Shapes(PPSlide.Shapes.Count).Line.ForeColor.RGB = RGB(0, 255, 0)
PPSlide.Shapes.AddLine 715, 17, 715, 507
PPSlide.Shapes(PPSlide.Shapes.Count).Line.DashStyle = 2 '1实线2虚线
PPSlide.Shapes(PPSlide.Shapes.Count).Line.Weight = 10
PPSlide.Shapes(PPSlide.Shapes.Count).Line.ForeColor.RGB = RGB(0, 255, 0)
PPSlide.Shapes.AddLabel 1, 150, 510, 450, 28
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Text = "温馨提示：欢迎提出修改建议"
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.Color = vbWhite
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.Font.size = 14
PPSlide.Shapes(PPSlide.Shapes.Count).TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
'==============以上为两竖线虚线============================================
InterferenceTJ PPSlide '干扰统计图表 '参数为Slide对象代表幻灯片。