私はVB6を使用して何かをすばやく一緒に叩きました、そしてあなたはそれをダウンロードすることができます:http:
//fournier.jonathan.googlepages.com/Vis2Img.exe
入力visioファイルパス、出力ファイルパス(ファイル拡張子に基づいてvisioエクスポート)、およびオプションでエクスポートするページ番号を渡すだけです。
また、私が使用したソースコードもあります。これをいじったり、VBScriptなどに変換したりする場合は、動作するはずですが、レイトバウンドコードへの変換を完了する必要があります。
お役に立てば幸いです。
ジョン
Dim TheCmd As String
Const visOpenRO = 2
Const visOpenMinimized = 16
Const visOpenHidden = 64
Const visOpenMacrosDisabled = 128
Const visOpenNoWorkspace = 256
Sub Main()
' interpret command line arguments - separated by spaces outside of double quotes
TheCmd = Command
Dim TheCmds() As String
If SplitCommandArg(TheCmds) Then
If UBound(TheCmds) > 1 Then
Dim PageNum As Long
If UBound(TheCmds) >= 3 Then
PageNum = Val(TheCmds(3))
Else
PageNum = 1
End If
' if the input or output file doesn't contain a file path, then assume the same
If InStr(1, TheCmds(1), "\") = 0 Then
TheCmds(1) = App.Path & "\" & TheCmds(1)
End If
If InStr(1, TheCmds(2), "\") = 0 Then
TheCmds(2) = App.Path & "\" & TheCmds(2)
End If
ConvertVisToImg TheCmds(1), TheCmds(2), PageNum
Else
' no good - need an in and out file
End If
End If
End Sub
Function ConvertVisToImg(ByVal InVisPath As String, ByVal OutImgPath As String, PageNum As Long) As Boolean
ConvertVisToImg = True
On Error GoTo PROC_ERR
' create a new visio instance
Dim VisApp As Visio.Application
Set VisApp = CreateObject("Visio.Application")
' open invispath
Dim ConvDoc As Visio.Document
Set ConvDoc = VisApp.Documents.OpenEx(InVisPath, visOpenRO + visOpenMinimized + visOpenHidden + visOpenMacrosDisabled + visOpenNoWorkspace)
' export to outimgpath
If Not ConvDoc.Pages(PageNum) Is Nothing Then
ConvDoc.Pages(PageNum).Export OutImgPath
Else
MsgBox "Invalid export page"
ConvertVisToImg = False
GoTo PROC_END
End If
' close it off
PROC_END:
On Error Resume Next
VisApp.Quit
Set VisApp = Nothing
Exit Function
PROC_ERR:
MsgBox Err.Description & vbCr & "Num:" & Err.Number
GoTo PROC_END
End Function
Function SplitCommandArg(ByRef Commands() As String) As Boolean
SplitCommandArg = True
'read through command and break it into an array delimited by space characters only when we're not inside double quotes
Dim InDblQts As Boolean
Dim CmdToSplit As String
CmdToSplit = TheCmd 'for debugging command line parser
'CmdToSplit = Command
Dim CharIdx As Integer
ReDim Commands(1 To 1)
For CharIdx = 1 To Len(CmdToSplit)
Dim CurrChar As String
CurrChar = Mid(CmdToSplit, CharIdx, 1)
If CurrChar = " " And Not InDblQts Then
'add another element to the commands array if InDblQts is false
If Commands(UBound(Commands)) <> "" Then ReDim Preserve Commands(LBound(Commands) To UBound(Commands) + 1)
ElseIf CurrChar = Chr(34) Then
'set InDblQts = true
If Not InDblQts Then InDblQts = True Else InDblQts = False
Else
Commands(UBound(Commands)) = Commands(UBound(Commands)) & CurrChar
End If
Next CharIdx
End Function