テンプレート内の設定の一覧表示（Microsoft Word）

Sub TemplateSettings()

Dim templatePath As String     Dim fleName As String     Dim str As String     Dim sTemp As String

' Select the template to be opened     templatePath = Application.Templates(1).Path     fleName = GetTemplateName(templatePath)

If fleName = "" Then         MsgBox "No template selected"

Exit Sub     End If

Application.Documents.Open (fleName)



str = ActiveDocument.Name & vbCr & vbCr

sTemp = "Other"

Select Case ActiveDocument.Sections(1).PageSetup.PaperSize         Case wdPaperLetter             sTemp = "Letter"

Case wdPaperLegal             sTemp = "Legal"

Case wdPaperA4             sTemp = "A4"

End Select     str = str & "Paper size: " & sTemp

sTemp = "Landscape"

If ActiveDocument.Sections(1).PageSetup.Orientation = wdOrientPortrait Then         sTemp = "Portrait"

End If     str = str & "  Orientation: " & sTemp & vbCr

str = str & "Margins " & marginsStr & vbCr     str = str & vbCr & "User Defined Tab stops " & UserTabStops & vbCr     str = str & vbCr & "User defined styles " & userStyles

Application.Documents(fleName).Close SaveChanges:=wdDoNotSaveChanges

MsgBox str End Sub

Function GetTemplateName(templatePath As String) As String     Dim dlg As FileDialog     Set dlg = Application.FileDialog( _       FileDialogType:=msoFileDialogFilePicker)

With dlg         .AllowMultiSelect = False         .InitialFileName = templatePath         .Filters.Clear         .Filters.Add "Templates", "*.dot"

.Filters.Add "All files", "."

.FilterIndex = 1         .Show         If .SelectedItems.Count > 0 Then             GetTemplateName = .SelectedItems(1)

Else             GetTemplateName = ""

End If     End With     Set dlg = Nothing End Function

Function userStyles() As String     Dim sty As Style     Dim s As String

s = ""

For Each sty In ActiveDocument.Styles         If Not sty.BuiltIn Then             s = vbCr & sty.NameLocal & "  " & sty.Description         End If     Next sty     userStyles = s End Function

Function UserTabStops() As String     Dim s As String     Dim tbStop As TabStop     Dim alg

alg = Array("Left", "Center", "Right", "Decimal", "Bar", "?", "List")

s = ""

For Each tbStop In ActiveDocument.Paragraphs(1).TabStops         s = s & vbCr & ptConvert(tbStop.Position) & _           " Alignment: " & alg(tbStop.Alignment)

Next tbStop     UserTabStops = s End Function

Function marginsStr() As String     With ActiveDocument         marginsStr = _           "Left: " & ptConvert(.PageSetup.LeftMargin) & _           ", Right: " & ptConvert(.PageSetup.RightMargin) & _           ", Top: " & ptConvert(.PageSetup.TopMargin) & _           ", Bottom: " & ptConvert(.PageSetup.BottomMargin)

End With End Function

Function ptConvert(p As Single) As String     ptConvert = Format(PointsToInches(p), "###.##")

' use the following line if you want dimensions in centimeters     'ptConvert = Format(PointsToCentimeters(p), "###.##")

End Function