Sub chenphAutoExport()
' 角色
Dim role(2) As String
role(0) = "普通教师"
role(1) = "高级教师"
' 分类
Dim sort(2) As String
sort(0) = "数学"
sort(1) = "语文"
' 班级
Dim class(2) As String
class(0) = "一班"
class(1) = "二班"
'Enable diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
Dim rootPath As String
'rootPath = "C:\Users\chenph-vm-win7\Desktop\Test\Auto\"
rootPath = ActiveDocument.Path + "\Auto-Chenph\"
For i = 0 To UBound(role) - 1
For j = 0 To UBound(sort) - 1
MakeDir (rootPath + role(i) + "\" + sort(j))
Next j
Next i
For i = 0 To UBound(role) - 1
For j = 0 To UBound(sort) - 1
For k = 0 To UBound(tradeType) - 1
Application.ActiveWindow.Page = Application.ActiveDocument.Pages.Item(1)
Dim vsoCharacters1 As Visio.Characters
Set vsoCharacters1 = Application.ActiveWindow.Page.Shapes.ItemFromID(179).Characters
vsoCharacters1.Text = "登录（" + role(i) + "）"
Application.Settings.SetRasterExportResolution visRasterUseScreenResolution, 96#, 96#, visRasterPixelsPerInch
Application.Settings.SetRasterExportSize visRasterFitToSourceSize, 1.583333, 1.1875, visRasterInch
Application.Settings.RasterExportColorFormat = visRasterRGB
Application.Settings.RasterExportOperation = visRasterBaseline
Application.Settings.RasterExportRotation = visRasterNoRotation
Application.Settings.RasterExportFlip = visRasterNoFlip
Application.Settings.RasterExportBackgroundColor = 16777215
Application.Settings.RasterExportQuality = 75
Application.ActiveWindow.Page.Export rootPath + "\" + role(i) + "\" + sort(j) + "\" + class(k) + "-" + Application.ActiveWindow.Page.Name + ".jpg"
Dim PageNamesU() As String
Application.ActiveDocument.ServerPublishOptions.SetPagesToPublish visPublishPageAll, PageNamesU, visLangUniversal
Dim RecordsetIDs() As Long
Application.ActiveDocument.ServerPublishOptions.SetRecordsetsToPublish visPublishDataRecordsetAll, RecordsetIDs
Application.ActiveDocument.SaveAsEx rootPath + "\" + role(i) + "\" + sort(j) + "\" + class(k) + ".vsd", visSaveAsWS + visSaveAsListInMRU
'Application.ActiveDocument.SaveAsEx rootPath + role(i) + sort(j) + class(k) + ".vsd", visSaveAsWS + visSaveAsListInMRU
Next k
Next j
Next i
'Restore diagram services
ActiveDocument.DiagramServicesEnabled = DiagramServices
End Sub
Public Sub MakeDir(Path As String)
On Error Resume Next
Dim o_strRet As String
Dim o_intItems As Integer
Dim o_vntItem As Variant
Dim o_strItems() As String
o_strItems() = Split(Path, "\")
o_intItems = 0
For Each o_vntItem In o_strItems()
o_intItems = o_intItems + 1
If o_intItems = 1 Then
o_strRet = o_vntItem
Else
o_strRet = o_strRet & "\" & o_vntItem
MkDir o_strRet
End If
Next
End Sub
原文地址
