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 メソッドがそれらしい気がするので,下記コードを試してみる.

 うまく行かない.

実行時エラー '4694':このテーマは見つかりませんでした.
実行時エラー ‘4694’:このテーマは見つかりませんでした.

ApplyDocumentTheme メソッドは成功する

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

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

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

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

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

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

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

実行時エラー '-2147467259 (80004005)':'ApplyDocumentTheme' メソッドは失敗しました: '_Document' オブジェクト
実行時エラー ‘-2147467259 (80004005)’:’ApplyDocumentTheme’ メソッドは失敗しました: ‘_Document’ オブジェクト

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください