Как написать макрос для пакетной операции «Подгонка под чертеж» в Visio? - PullRequest
Новая
       19

Как написать макрос для пакетной операции «Подгонка под чертеж» в Visio?

1 голос
/ 25 апреля 2019

Мне нужно сначала сохранить все файлы Visio, применив параметр «Подогнать к чертежу», а затем я хочу сохранить их в виде файлов PDF.Но я не очень знаком с макросами.Кто-нибудь может мне помочь?

Моя структура папок выглядит следующим образом:

  • Папка с файлами Visio
    • Файл Visio
    • Файл Visio
  • Папка с файлами Visio
    • Файл Visio

Мне нужно иметь файл PDF для каждого файла Visio наконец и все диаграммы должны быть приведены к чертежу.Я использую Visio 2013.

1 Ответ

2 голосов
/ 25 апреля 2019

Надеюсь, этот код поможет! 

Sub Macro1()
Dim fso As Object, m_fld As Object, fld As Object, vd As Object, mf As String
Dim pdfn As String
Set fso = CreateObject("Scripting.FileSystemObject")
mf = InputBox("Path")
Set m_fld = fso.getfolder(mf)
For Each fld In m_fld.subfolders
    For Each fil In fld.Files
    If InStr(fil.Name, ".vsd") > 0 Then fit (fil.Path) ' MsgBox fil.Name
    Next
Next
For Each fil In m_fld.Files
    If InStr(fil.Name, ".vsd") > 0 Then fit (fil.Path)
Next
End Sub
Sub fit(fn As String)
Dim fd As Document
Set fd = Documents.OpenEx(fn, visOpenRW)
pdfn = Replace(fd.FullName, Right(fd.FullName, Len(fd.FullName) - InStrRev(fd.FullName, ".")), "pdf")
For Each pg In fd.Pages
    fd.Application.ActiveWindow.Page = pg.Name
    Application.ActiveWindow.ViewFit = visFitPage
Next
fd.ExportAsFixedFormat visFixedFormatPDF, pdfn, visDocExIntentScreen, visPrintAll
fd.Save
fd.Close
End Sub
...