|
根据Excel数据制作展示PPT
在本期中，会尝试完成一个比较复杂的案例。这里例子来自于版面上一位网友aulian的问题：在一个Excel表中，包含了一系列图像文件在本机的路径，记录数量上千，那么如何快速制作一个展示用的PPT，使得PPT包含所有的图像，并且每页有四张图？这个案例涉及到了Excel和PowerPoint的联合编程。
首先假设用于输入的Excel文件格式是这样的。它只包含一列数据path，即图像文件的相对路径。如下图所示：
因为大部分的工作都是由PowerPoint来做，所以本程序将书写在PowerPoint中。在PowerPoint的VBA工程中创建一个模块，并编写CreateAutoPPT。在这个例子中，此Sub仅仅是个启动用户界面的入口。
Sub CreateShowPPT()
AutoShowForm.Show
End Sub
接下来的工作是制作一个用户窗体AutoShowForm，使其可以提供比较丰富的配置功能，使得程序更加灵活。窗体的效果如下图所示（我标出了控件的名称，和下文代码对照）：
相关代码为：
Option ExplicitPrivate Sub btnBrowseDict_Click()
Dim dd As FileDialog
Set dd = Application.FileDialog(msoFileDialogFolderPicker)
If dd.Show = -1 Then
txtImagePath.Text = dd.SelectedItems(1)
End If
End Sub
Private Sub btnExit_Click()
Unload Me
End Sub
Private Sub btnBrowseFile_Click()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Filters.Clear
fd.Filters.Add "Excel文档", "*.xls; *.xlsx; *.xlsm; *.xlsb"
fd.Filters.Add "所有文件", "*.*"
If fd.Show = -1 Then
txtXlsPath.Text = fd.SelectedItems(1)
End If
End Sub
Private Sub btnRun_Click()
'Parameters check
If txtXlsPath.Text = "" Then
MsgBox "请输入Excel文件的路径"
Exit Sub
End If
If txtColumn.Text = "" Then
MsgBox "请输入图像文件路径所在的列名"
Exit Sub
End If
Dim bAbsoluteImgPath As Boolean, bHeader As Boolean
bAbsoluteImgPath = ckbAbsolutePath.Value
bHeader = ckbHeader.Value
Insert txtXlsPath.Text, txtImagePath.Text, txtColumn.Text, bAbsoluteImgPath, bHeader
MsgBox "任务完成"
End Sub
Private Sub ckbAbsolutePath_Change()
If ckbAbsolutePath.Value = True Then
txtImagePath.Enabled = False
btnBrowseDict.Enabled = False
Else
txtImagePath.Enabled = True
btnBrowseDict.Enabled = True
End If
End Sub
这部分代码定义了当几个按键被按下后要进行的工作。其中，btnBrowseFile按键即为图中“Excel文件路径”后边的“浏览”按键。它被按下后就会启动一个“Open File”对话框。这个对话框是由Application.FileDialog来直接提供的，不需要我们自己编写。你只要告诉它打开“msoFileDialogFilePicker”这种对话框即可——即用于选取文件的文件对话框。在显示之前，添加一些文件类型过滤器，使得只有Excel文件会被显示出来，如下图所示。这是由FileDialog.Filters.Add来添加的。
FileDialog.Show函数就会使得文件对话框被显示出来。当用户选好文件，按“确定”退出文件对话框时，Show函数就会返回一个-1（如果是按“取消”退出，则会返回0）。所以就会有If fd.Show = -1 Then …这样的语句，将用户确定选中的文件路径放到文本框txtXlsPath中。这样浏览和选择Excel文件路径的工作就结束了。
选择图像文件根路径的工作与选择Excel文件非常类似，只是将文件对话框的类型改为了msoFileDialogFolderPicker——选择文件夹的文件对话框。如果输入的Excel文件中的图像文件路径均为相对路径，这个“根路径”就是拼接在每个相对路径之前的路径。通过综合使用图像文件夹根路径和复选框“Excel中的图像路径使用绝对路径”，就可以允许用户在输入的Excel中使用绝对路径或者相对路径。
在将所有的配置填好之后，点击btnRun，程序就开始进行简单的输入检查，防止用户输入的一些漏洞。当一切没有问题之后，所有的配置会以参数的形式传递给Insert这个Sub。这是本程序的核心Sub。下面是这个Sub的代码：
Sub Insert(xlsPath As String, imageRoot As String, column As String, bAbsolulteImgPath As Boolean, bHeader As Boolean)
ClearAllSlides
Dim excelApp As New Excel.Application
Set workbook = excelApp.Workbooks.Open(FileName:=xlsPath)
workbook.Activate
Dim imagePath As String
Dim layout As CustomLayout
Set layout = ActivePresentation.SlideMaster.CustomLayouts(7) '7 means a blank layout
Dim i As Integer
Dim curr As slide 'Current slide
If (bHeader = True) Then
i = 2
Else
i = 1
End If
'Insert slides
Do
Set Cell = workbook.Sheets(1).Range(column & i)
If Cell.Value = "" Then workbook.Close: excelApp.Quit: Exit Sub
With ActivePresentation
.Slides.AddSlide .Slides.Count + 1, layout 'Create a new slide
Set curr = .Slides(.Slides.Count)
If bAbsoluteImgPath = False Then
imagePath = imageRoot & "" & Cell.Value
Else
imagePath = Cell.Value
End If
i = i + 1
PutImage imagePath, 1, curr 'Insert the first picture
'Insert the second to fourth pictures
Dim j As Integer
For j = 2 To 4
Set Cell = Workbook.Sheets(1).Range(column & i)
If Cell.Value = "" Then Workbook.Close: excelApp.Quit: Exit Sub
If bAbsoluteImgPath = False Then
imagePath = imageRoot & "" & Cell.Value
Else
imagePath = Cell.Value
End If
i = i + 1
PutImage imagePath, j, curr
Next
End With
Loop While True
End Sub
这个Sub的第一步就是利用ClearAllSlides删除PPT文件中所有已有的幻灯片。其代码为：
Private Sub ClearAllSlides()
'Clear the existig slides
Dim i As Integer
Dim n As Integer
n = ActivePresentation.Slides.Count
For i = 1 To n
ActivePresentation.Slides(1).Delete
Next
End Sub
这个Sub依次遍历ActivePresentation（即当前活动的PPT文件）的每个Slide，并将其删除。注意这里每次都应用了Slides(1)，而不是Slides(i)。这是因为，每次删掉一个幻灯片，原来编号为2的幻灯片的编号就会变成1，依次类推，直到最后一个幻灯片被删干净。
删除完了之后，就要打开Excel文件读取其内容：
...
Dim excelApp As New Excel.Application
Set Workbook = excelApp.Workbooks.Open(FileName:=xlsPath)
Workbook.Activate
...
由于代码是写在PowerPoint中，所以为了让上面代码正确执行，必须首先添加对Microsoft Excel 12.0 Object Library的引用（这里用的Excel 2007的版本对应库的版本号是12.0，所以如果你安装的是2003，就只能看到11.0这样的版本号）。这段代码新建了一个Excel.Application对象。实际上就是启动了一个Excel程序，只不过没有显示罢了。在Windows任务管理器中可以看到在这句执行后确实有个Excel.exe在执行。如果希望其显示出来，执行excelApp.Visible=True即可。不过在本例子中，没有必要让其显示。启动Excel后，利用其Workbooks.Open函数打开一个Excel文件。这个文件的路径正是上面在txtXlsPath中输入的那个路径。最后将此Workbook激活，以备后用。
之后，程序定义了一个用于幻灯片母版（SlideMaster）的Layout：
...
Set layout = ActivePresentation.SlideMaster.CustomLayouts(7) '7 means a blank layout
...
所谓Layout就是PowerPoint中的“版式”，每个版式都有一个内部编号：
可以看到7正是“空白”。因为我们不需要任何“占位符”（如果你不清楚什么是PowerPoint的母版和占位符，请查阅相关帮助——它们对于日常的PowerPoint应用很重要）。
接下来，要确定该从Excel的哪行开始读取。如果考虑标题行，就从第二行开始读；否则就从第一行开始读。这就是下面这段代码做的事情：
...
If (bHeader = True) Then
i = 2
Else
i = 1
End If
...
终于，可以进行实际的数据读取工作了。因为每个幻灯片要放四幅图，所以如果当前的图片刚好是一个幻灯片里的第一幅图片，就需要新建一个幻灯片，然后把图插进去：
...
Set Cell = workbook.Sheets(1).Range(column & i)
If Cell.Value = "" Then workbook.Close: excelApp.Quit: Exit Sub
With ActivePresentation
.Slides.AddSlide .Slides.Count + 1, layout 'Create a new slide
Set curr = .Slides(.Slides.Count)
...
可以看到，这里对Excel的数据做了一些假设，即数据总是在Sheets(1)里，并且如果一旦某一行的数据为空，就认为后边没有数据了，于是就退出Insert；否则，就新建一个幻灯片。这是由Slides.Add方法做到的。它需要两个参数，一是要插入的位置，二是新幻灯片的版式。上面的语句中就是插入一个具有“空白”版式的幻灯片到所有已有幻灯片的最后边。然后让curr指向新被插入的幻灯片。
此外，这里用了With语法，它可以使得书写代码更加简便一些，不用每次都写一长串对象的引用。在上面这个例子的With...End With内，每个以.开头的语句都等价于以ActivePresentation.，这就省略了每次都要写一遍ActivePresentation的麻烦。
新建幻灯片之后，需要构造图片的实际路径：
If bAbsoluteImgPath = False Then
imagePath = imageRoot & "" & Cell.Value
Else
imagePath = Cell.Value
End If
如果是相对路径，就要将用户窗体中的图片根路径和Excel文件中记录的相对路径做拼接。否则，直接用就好了。
得到图片路径之后，就要进行实际的在幻灯片中加入图片的工作了。这是由PutImage来实现的，其代码为：
'Pos 1, 2, 3, 4 means left top, right top, lef bottom, right bottom
Private Sub PutImage(imgPath As String, pos As Integer, slide As Slide)
'set postion
Dim left As Integer, top As Integer, width As Integer, height As Integer
Select Case pos
Case 1: left = 5: top = 5
Case 2: left = ActivePresentation.PageSetup.SlideWidth / 2 + 5: top = 5
Case 3: left = 30: top = ActivePresentation.PageSetup.SlideHeight / 2 + 5
Case 4: left = ActivePresentation.PageSetup.SlideWidth / 2 + 5: top = ActivePresentation.PageSetup.SlideHeight / 2 + 5
End Select
width = ActivePresentation.PageSetup.SlideWidth / 2 - 10
height = ActivePresentation.PageSetup.SlideHeight / 2 - 10
slide.Shapes.AddPicture imgPath, msoFalse, msoTrue, left, top, width, height
End Sub
这个Sub接受三个参数，文件的绝对路径imgPath{String}，位置号pos{Integer}和要插入的幻灯片对象slide{Slide}。其中位置号可以是1、2、3、4，分别对应左上、右上、左下、右下。根据位置号，可以计算出图片应该插入的位置，即左上角的坐标left, top和尺寸width, height。这里用了ActivePresentation.PageSetup对象来获得幻灯片的实际尺寸，以应付幻灯片尺寸不确定的问题。当位置和尺寸都确定好了，就利用Slide.Shapes.AddPicture将图片插入到幻灯片中。因此调用：
PutImage imgPath, 1, curr
可以将一幅图片放到幻灯片curr的左上角。
最后，当Excel的数据全部被读完，一定要记得关闭打开的workbook{Workbook}和excelApp{Excel.Application}。正如上面的代码显示的那样，需要调用：
workbook.Close 和
excelApp.Quit
如果workbook不关闭，它就无法被其他的程序打开；excelApp如果不关闭，就会一直占用内存，等价于一直开着Excel一样（只是你看不见罢了）。如果同时运行数次这个程序而不关闭excelApp，就相当于打开数个Excel而不关闭。
程序运行完之后，会弹出对话框提示：
...
MsgBox "任务完成"
...
好啦，可以看一下最后的运行结果。
在本期教程中，讲解了如何使用VBA联合Excel，PowerPoint和用户窗体一起制作一个完整的程序。如果Excel中记录上千的话，使用这个程序来制作PPT的时间不会超过10秒钟。而编写这样一个程序，包括测试在内不会超过1小时。这可以说明VBA对提高大量重复性工作的效率是极为有效的。本程序也许比较长和繁杂，但是这是假设程序需要一定灵活的配置的前提下才会如此。如果可以假设输入Excel的数据格式（比如使用相对路径还是绝对路径，有没有列头，路径所在列的名称等）是确定的，则可以对程序进行相当多的简化。
在下一期中，将会讲解利用VBA如何使得Excel和Word进行合作的。
|
