Visio批量修改圖形內容,匯出圖片,另存為新檔案
阿新 • • 發佈:2019-01-07
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