Word ドキュメントの規定の Office テーマを VBA から指定する

　Word の規定のテーマはマクロ記録できない．EXCEL ならできる．Power Point はマクロ記録自体が廃止されている．EXCEL の記録を流用してみた．

オブジェクトブラウザーから

　Officeテーマの色空間を探索するで述べた，雛形ファイルを指定する方法が流用できそうだ．

　オブジェクトブラウザーで Document オブジェクトを観察すると Apply で始まるメソッドが 3 つほどある．ApplyDocumentTheme メソッド，ApplyQuickStyleSet2 メソッド，ApplyTheme メソッドである．

Member		Return
AcceptAllRevisions()	Sub
AcceptAllRevisionsShown()	Sub
Activate()	Sub
ActiveTheme	Property	String
ActiveThemeDisplayName	Property	String
ActiveWindow	Property	Window
ActiveWritingStyle(LanguageID)	Property	String
AddToFavorites()	Sub
Application	Property	Application
ApplyDocumentTheme(FileName As String)	Sub
ApplyQuickStyleSet2(Style)	Sub
ApplyTheme(Name As String)	Sub
AttachedTemplate	Property	Variant
AutoFormat()	Sub
AutoFormatOverride	Property	Boolean
AutoHyphenation	Property	Boolean
AutoSaveOn	Property	Boolean
Background	Property	Shape
Bibliography	Property	Bibliography
Bookmarks	Property	Bookmarks
Broadcast	Property	Broadcast
BuildingBlockInsert(Range As Range, Name As String, Category As String, BlockType As String, Template As String)	Event
BuiltInDocumentProperties	Property	Object
CanCheckin()	Function	Boolean
Characters	Property	Characters
ChartDataPointTrack	Property	Boolean
CheckConsistency()	Sub
CheckGrammar()	Sub
CheckIn([SaveChanges As Boolean = True], [Comments], [MakePublic As Boolean = False])	Sub
CheckInWithVersion([SaveChanges As Boolean = True], [Comments], [MakePublic As Boolean = False], [VersionType])	Sub
CheckSpelling([CustomDictionary], [IgnoreUppercase], [AlwaysSuggest], [CustomDictionary2], [CustomDictionary3], [CustomDictionary4], [CustomDictionary5], [CustomDictionary6], [CustomDictionary7], [CustomDictionary8], [CustomDictionary9], [CustomDictionary10])	Sub
ClickAndTypeParagraphStyle	Property	Variant
Close([SaveChanges], [OriginalFormat], [RouteDocument])	Sub
Close()	Event
ClosePrintPreview()	Sub
CoAuthoring	Property	CoAuthoring
CodeName	Property	String
CommandBars	Property	CommandBars
Comments	Property	Comments
Compare(Name As String, [AuthorName], [CompareTarget], [DetectFormatChanges], [IgnoreAllComparisonWarnings], [AddToRecentFiles], [RemovePersonalInformation], [RemoveDateAndTime])	Sub
Compatibility(Type As WdCompatibility)	Property	Boolean
CompatibilityMode	Property	Long
ComputeStatistics(Statistic As WdStatistic, [IncludeFootnotesAndEndnotes])	Function	Long
ConsecutiveHyphensLimit	Property	Long
Container	Property	Object
Content	Property	Range
ContentControlAfterAdd(NewContentControl As ContentControl, InUndoRedo As Boolean)	Event
ContentControlBeforeContentUpdate(ContentControl As ContentControl, Content As String)	Event
ContentControlBeforeDelete(OldContentControl As ContentControl, InUndoRedo As Boolean)	Event
ContentControlBeforeStoreUpdate(ContentControl As ContentControl, Content As String)	Event
ContentControlOnEnter(ContentControl As ContentControl)	Event
ContentControlOnExit(ContentControl As ContentControl, Cancel As Boolean)	Event
ContentControls	Property	ContentControls
ContentTypeProperties	Property	MetaProperties
Convert()	Sub
ConvertAutoHyphens()	Sub
ConvertNumbersToText([NumberType])	Sub
ConvertVietDoc(CodePageOrigin As Long)	Sub
CopyStylesFromTemplate(Template As String)	Sub
CountNumberedItems([NumberType], [Level])	Function	Long
CreateLetterContent(DateFormat As String, IncludeHeaderFooter As Boolean, PageDesign As String, LetterStyle As WdLetterStyle, Letterhead As Boolean, LetterheadLocation As WdLetterheadLocation, LetterheadSize As Single, RecipientName As String, RecipientAddress As String, Salutation As String, SalutationType As WdSalutationType, RecipientReference As String, MailingInstructions As String, AttentionLine As String, Subject As String, CCList As String, ReturnAddress As String, SenderName As String, Closing As String, SenderCompany As String, SenderJobTitle As String, SenderInitials As String, EnclosureNumber As Long, [InfoBlock], [RecipientCode], [RecipientGender], [ReturnAddressShortForm], [SenderCity], [SenderCode], [SenderGender], [SenderReference])	Function	LetterContent
Creator	Property	Long
CurrentRsid	Property	Long
CustomDocumentProperties	Property	Object
CustomXMLParts	Property	CustomXMLParts
DataForm()	Sub
DefaultTableStyle	Property	Variant
DefaultTabStop	Property	Single
DefaultTargetFrame	Property	String
DeleteAllComments()	Sub
DeleteAllCommentsShown()	Sub
DeleteAllEditableRanges([EditorID])	Sub
DeleteAllInkAnnotations()	Sub
DetectLanguage()	Sub
DisableFeatures	Property	Boolean
DisableFeaturesIntroducedAfter	Property	WdDisableFeaturesIntroducedAfter
DocumentInspectors	Property	DocumentInspectors
DocumentLibraryVersions	Property	DocumentLibraryVersions
DocumentTheme	Property	OfficeTheme
DoNotEmbedSystemFonts	Property	Boolean
DowngradeDocument()	Sub
Email	Property	Email
EmbedLinguisticData	Property	Boolean
EmbedTrueTypeFonts	Property	Boolean
EncryptionProvider	Property	String
Endnotes	Property	Endnotes
EndReview()	Sub
EnforceStyle	Property	Boolean
Envelope	Property	Envelope
ExportAsFixedFormat(OutputFileName As String, ExportFormat As WdExportFormat, [OpenAfterExport As Boolean = False], [OptimizeFor As WdExportOptimizeFor = wdExportOptimizeForPrint], [Range As WdExportRange = wdExportAllDocument], [From As Long = 1], [To As Long = 1], [Item As WdExportItem = wdExportDocumentContent], [IncludeDocProps As Boolean = False], [KeepIRM As Boolean = True], [CreateBookmarks As WdExportCreateBookmarks = wdExportCreateNoBookmarks], [DocStructureTags As Boolean = True], [BitmapMissingFonts As Boolean = True], [UseISO19005_1 As Boolean = False], [FixedFormatExtClassPtr])	Sub
ExportAsFixedFormat2(OutputFileName As String, ExportFormat As WdExportFormat, [OpenAfterExport As Boolean = False], [OptimizeFor As WdExportOptimizeFor = wdExportOptimizeForPrint], [Range As WdExportRange = wdExportAllDocument], [From As Long = 1], [To As Long = 1], [Item As WdExportItem = wdExportDocumentContent], [IncludeDocProps As Boolean = False], [KeepIRM As Boolean = True], [CreateBookmarks As WdExportCreateBookmarks = wdExportCreateNoBookmarks], [DocStructureTags As Boolean = True], [BitmapMissingFonts As Boolean = True], [UseISO19005_1 As Boolean = False], [OptimizeForImageQuality As Boolean = False], [FixedFormatExtClassPtr])	Sub
FarEastLineBreakLanguage	Property	WdFarEastLineBreakLanguageID
FarEastLineBreakLevel	Property	WdFarEastLineBreakLevel
Fields	Property	Fields
Final	Property	Boolean
FitToPages()	Sub
FollowHyperlink([Address], [SubAddress], [NewWindow], [AddHistory], [ExtraInfo], [Method], [HeaderInfo])	Sub
Footnotes	Property	Footnotes
FormattingShowClear	Property	Boolean
FormattingShowFilter	Property	WdShowFilter
FormattingShowFont	Property	Boolean
FormattingShowNextLevel	Property	Boolean
FormattingShowNumbering	Property	Boolean
FormattingShowParagraph	Property	Boolean
FormattingShowUserStyleName	Property	Boolean
FormFields	Property	FormFields
FormsDesign	Property	Boolean
Frames	Property	Frames
Frameset	Property	Frameset
FreezeLayout()	Sub
FullName	Property	String
GetCrossReferenceItems(ReferenceType)	Function
GetLetterContent()	Function	LetterContent
GetWorkflowTasks()	Function	WorkflowTasks
GetWorkflowTemplates()	Function	WorkflowTemplates
GoTo([What], [Which], [Count], [Name])	Function	Range
GrammarChecked	Property	Boolean
GrammaticalErrors	Property	ProofreadingErrors
GridDistanceHorizontal	Property	Single
GridDistanceVertical	Property	Single
GridOriginFromMargin	Property	Boolean
GridOriginHorizontal	Property	Single
GridOriginVertical	Property	Single
GridSpaceBetweenHorizontalLines	Property	Long
GridSpaceBetweenVerticalLines	Property	Long
HasPassword	Property	Boolean
HasVBProject	Property	Boolean
HTMLDivisions	Property	HTMLDivisions
Hyperlinks	Property	Hyperlinks
HyphenateCaps	Property	Boolean
HyphenationZone	Property	Long
Indexes	Property	Indexes
InlineShapes	Property	InlineShapes
IsInAutosave	Property	Boolean
IsMasterDocument	Property	Boolean
IsSubdocument	Property	Boolean
JustificationMode	Property	WdJustificationMode
KerningByAlgorithm	Property	Boolean
Kind	Property	WdDocumentKind
LanguageDetected	Property	Boolean
ListParagraphs	Property	ListParagraphs
Lists	Property	Lists
ListTemplates	Property	ListTemplates
LockQuickStyleSet	Property	Boolean
LockServerFile()	Sub
LockTheme	Property	Boolean
MailEnvelope	Property	MsoEnvelope
MailMerge	Property	MailMerge
MakeCompatibilityDefault()	Sub
ManualHyphenation()	Sub
Merge(FileName As String, [MergeTarget], [DetectFormatChanges], [UseFormattingFrom], [AddToRecentFiles])	Sub
Name	Property	String
New()	Event
NoLineBreakAfter	Property	String
NoLineBreakBefore	Property	String
OMathBreakBin	Property	WdOMathBreakBin
OMathBreakSub	Property	WdOMathBreakSub
OMathFontName	Property	String
OMathIntSubSupLim	Property	Boolean
OMathJc	Property	WdOMathJc
OMathLeftMargin	Property	String
OMathNarySupSubLim	Property	Boolean
OMathRightMargin	Property	Single
OMaths	Property	OMaths
OMathSmallFrac	Property	Boolean
OMathWrap	Property	Single
Open()	Event
OpenEncoding	Property	MsoEncoding
OptimizeForWord97	Property	Boolean
OriginalDocumentTitle	Property	String
PageSetup	Property	PageSetup
Paragraphs	Property	Paragraphs
Parent	Property	Object
Password	Property	String
PasswordEncryptionAlgorithm	Property	String
PasswordEncryptionFileProperties	Property	Boolean
PasswordEncryptionKeyLength	Property	Long
PasswordEncryptionProvider	Property	String
Path	Property	String
Permission	Property	Permission
Post()	Sub
PresentIt()	Sub
PrintFormsData	Property	Boolean
PrintOut([Background], [Append], [Range], [OutputFileName], [From], [To], [Item], [Copies], [Pages], [PageType], [PrintToFile], [Collate], [ActivePrinterMacGX], [ManualDuplexPrint], [PrintZoomColumn], [PrintZoomRow], [PrintZoomPaperWidth], [PrintZoomPaperHeight])	Sub
PrintPostScriptOverText	Property	Boolean
PrintPreview()	Sub
PrintRevisions	Property	Boolean
Protect(Type As WdProtectionType, [NoReset], [Password], [UseIRM], [EnforceStyleLock])	Sub
ProtectionType	Property	WdProtectionType
Range([Start], [End])	Property	Range
ReadabilityStatistics	Property	ReadabilityStatistics
ReadingLayoutSizeX	Property	Long
ReadingLayoutSizeY	Property	Long
ReadingModeLayoutFrozen	Property	Boolean
ReadOnly	Property	Boolean
ReadOnlyRecommended	Property	Boolean
Redo([Times])	Function	Boolean
RejectAllRevisions()	Sub
RejectAllRevisionsShown()	Sub
Reload()	Sub
ReloadAs(Encoding As MsoEncoding)	Sub
RemoveDateAndTime	Property	Boolean
RemoveDocumentInformation(RemoveDocInfoType As WdRemoveDocInfoType)	Sub
RemoveLockedStyles()	Sub
RemoveNumbers([NumberType])	Sub
RemovePersonalInformation	Property	Boolean
RemoveTheme()	Sub
Repaginate()	Sub
ReplyWithChanges([ShowMessage])	Sub
Research	Property	Research
ResetFormFields()	Sub
ReturnToLastReadPosition()	Function	Long
RevisedDocumentTitle	Property	String
Revisions	Property	Revisions
RunAutoMacro(Which As WdAutoMacros)	Sub
RunLetterWizard([LetterContent], [WizardMode])	Sub
Save()	Sub
SaveAs2([FileName], [FileFormat], [LockComments], [Password], [AddToRecentFiles], [WritePassword], [ReadOnlyRecommended], [EmbedTrueTypeFonts], [SaveNativePictureFormat], [SaveFormsData], [SaveAsAOCELetter], [Encoding], [InsertLineBreaks], [AllowSubstitutions], [LineEnding], [AddBiDiMarks], [CompatibilityMode])	Sub
SaveAsQuickStyleSet(FileName As String)	Sub
Saved	Property	Boolean
SaveEncoding	Property	MsoEncoding
SaveFormat	Property	Long
SaveFormsData	Property	Boolean
SaveSubsetFonts	Property	Boolean
Scripts	Property	Scripts
Sections	Property	Sections
Select()	Sub
SelectAllEditableRanges([EditorID])	Sub
SelectContentControlsByTag(Tag As String)	Function	ContentControls
SelectContentControlsByTitle(Title As String)	Function	ContentControls
SelectLinkedControls(Node As CustomXMLNode)	Function	ContentControls
SelectNodes(XPath As String, [PrefixMapping As String], [FastSearchSkippingTextNodes As Boolean = True])	Function	XMLNodes
SelectSingleNode(XPath As String, [PrefixMapping As String], [FastSearchSkippingTextNodes As Boolean = True])	Function	XMLNode
SelectUnlinkedControls([Stream As CustomXMLPart])	Function	ContentControls
SendFax(Address As String, [Subject])	Sub
SendFaxOverInternet([Recipients], [Subject], [ShowMessage])	Sub
SendForReview([Recipients], [Subject], [ShowMessage], [IncludeAttachment])	Sub
SendMail()	Sub
Sentences	Property	Sentences
ServerPolicy	Property	ServerPolicy
SetCompatibilityMode(Mode As Long)	Sub
SetDefaultTableStyle(Style, SetInTemplate As Boolean)	Sub
SetLetterContent(LetterContent)	Sub
SetPasswordEncryptionOptions(PasswordEncryptionProvider As String, PasswordEncryptionAlgorithm As String, PasswordEncryptionKeyLength As Long, [PasswordEncryptionFileProperties])	Sub
Shapes	Property	Shapes
ShowGrammaticalErrors	Property	Boolean
ShowSpellingErrors	Property	Boolean
Signatures	Property	SignatureSet
SmartDocument	Property	SmartDocument
SnapToGrid	Property	Boolean
SnapToShapes	Property	Boolean
SpellingChecked	Property	Boolean
SpellingErrors	Property	ProofreadingErrors
StoryRanges	Property	StoryRanges
Styles	Property	Styles
StyleSheets	Property	StyleSheets
StyleSortMethod	Property	WdStyleSort
Subdocuments	Property	Subdocuments
Sync	Property	Sync
Sync(SyncEventType As MsoSyncEventType)	Event
Tables	Property	Tables
TablesOfAuthorities	Property	TablesOfAuthorities
TablesOfAuthoritiesCategories	Property	TablesOfAuthoritiesCategories
TablesOfContents	Property	TablesOfContents
TablesOfFigures	Property	TablesOfFigures
TextEncoding	Property	MsoEncoding
TextLineEnding	Property	WdLineEndingType
ToggleFormsDesign()	Sub
TrackFormatting	Property	Boolean
TrackMoves	Property	Boolean
TrackRevisions	Property	Boolean
TransformDocument(Path As String, [DataOnly As Boolean = True])	Sub
Type	Property	WdDocumentType
Undo([Times])	Function	Boolean
UndoClear()	Sub
Unprotect([Password])	Sub
UpdateStyles()	Sub
UpdateStylesOnOpen	Property	Boolean
UseMathDefaults	Property	Boolean
UserControl	Property	Boolean
Variables	Property	Variables
VBASigned	Property	Boolean
VBProject	Property	VBProject
ViewCode()	Sub
ViewPropertyBrowser()	Sub
WebOptions	Property	WebOptions
WebPagePreview()	Sub
Windows	Property	Windows
WordOpenXML	Property	String
Words	Property	Words
WorkIdentity	Property	String
WritePassword	Property	String
WriteReserved	Property	Boolean
XMLAfterInsert(NewXMLNode As XMLNode, InUndoRedo As Boolean)	Event
XMLBeforeDelete(DeletedRange As Range, OldXMLNode As XMLNode, InUndoRedo As Boolean)	Event
XMLSaveThroughXSLT	Property	String
XMLSchemaReferences	Property	XMLSchemaReferences
XMLShowAdvancedErrors	Property	Boolean
XMLUseXSLTWhenSaving	Property	Boolean

ApplyTheme メソッドは失敗する

　ApplyTheme メソッドがそれらしい気がするので，下記コードを試してみる．

Sub Sample()
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Ion.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Ion Boardroom.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Integral.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Wisp.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Organic.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Gallery.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Slice.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Facet.thmx")
ActiveDocument.ApplyTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Retrospect.thmx")
End Sub

　うまく行かない．

ApplyDocumentTheme メソッドは成功する

　ApplyDocumentTheme メソッドを試してみる．うまく行くようだ．

Sub Macro3()
Debug.Print ActiveDocument.ActiveTheme
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Ion.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Ion Boardroom.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Integral.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Wisp.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Organic.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Gallery.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Slice.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Facet.thmx")
ActiveDocument.ApplyDocumentTheme ("C:\Program Files\Microsoft Office\Root\Document Themes 16\Retrospect.thmx")
Debug.Print ActiveDocument.ActiveTheme
End Sub

　イミディエイトウィンドウには下記のように出力される．実際に変更されているのかは不明である．

C:\Program Files\Microsoft Office\root\Document Themes 16\Facet.thmx 011
C:\Program Files\Microsoft Office\root\Document Themes 16\Facet.thmx 011

後半の雛形ファイルの指定は…?

　EXCEL では後半の雛形ファイルによるテーマの指定はうまく行かなかった．Word でも試してみる．

Sub JP_Sample()
Debug.Print ActiveDocument.ActiveTheme
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM10001114[[fn=ギャラリー]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457503[[fn=クォータブル]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033925[[fn=しずく]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457510[[fn=シャボン]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033921[[fn=ダマスク]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM10001105[[fn=トリミング]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM10001115[[fn=パーセル]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM10001106[[fn=バッジ]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457515[[fn=ビュー]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457475[[fn=フレーム]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033917[[fn=ベルリン]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033927[[fn=メイン イベント]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457485[[fn=メッシュ]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457491[[fn=メトロポリタン]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033919[[fn=回路]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457444[[fn=基礎]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457496[[fn=視差]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03090430[[fn=縞模様]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033929[[fn=石版]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03457464[[fn=配当]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM04033937[[fn=飛行機雲]].thmx")
ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1041\TM03090434[[fn=木版活字]].thmx")
Debug.Print ActiveDocument.ActiveTheme
End Sub

　エラーは発生しないものの，現在どのテーマが選ばれているのかよく分からない．イミディエイトウィンドウには下記のように出力される．実際に変更されているのかは不明である．

C:\Program Files\Microsoft Office\root\Document Themes 16\Facet.thmx 011
C:\Program Files\Microsoft Office\root\Document Themes 16\Facet.thmx 011

　では英語ファイルならどうだろうか？

Sub sample3()
Debug.Print ActiveDocument.ActiveTheme
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM10001106[[fn=Badge]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03090430[[fn=Banded]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457444[[fn=Basis]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033917[[fn=Berlin]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033919[[fn=Circuit]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM10001105[[fn=Crop]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033921[[fn=Damask]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457464[[fn=Dividend]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033925[[fn=Droplet]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM10001104[[fn=Feathered]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457475[[fn=Frame]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM10001114[[fn=Gallery]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM10001103[[fn=Headlines]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033927[[fn=Main Event]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457485[[fn=Mesh]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457491[[fn=Metropolitan]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457496[[fn=Parallax]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM10001115[[fn=Parcel]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457503[[fn=Quotable]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457510[[fn=Savon]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033929[[fn=Slate]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM04033937[[fn=Vapor Trail]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03457515[[fn=View]].thmx")
    ActiveDocument.ApplyTheme ("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\LiveContent\16\Managed\Document Themes\1033\TM03090434[[fn=Wood Type]].thmx")
Debug.Print ActiveDocument.ActiveTheme
End Sub

　こちらは失敗する．この辺りは最初にインストールした環境に依存するのかもしれない．