ThisDocumentモジュールに次をコピーします
Private Sub Document_Open()
MsgBox "You Opened Template with Macro or File Which was made with template by QIIQ from Qiita. This Macro include Publisher Macro Starter Procedure. Push Alt+F11 and see Module 1." & vbCrLf &
"Last Update 2018/4/8"
End Sub
標準モジュールを挿入し TypeSetModuleとして以下をコピーします
Publksher_VBAStart
Option Explicit
'''Type Set List ''''
'''''''''-Application-'''''''''''''
'Public Type AppSet
'''''''''-Options-'''''''''''''
'Public Type pbOptionsSet
'''''''''-Shape-'''''''''''''
'Public Type pbShapeSize ' Ss
'''''''''-ShapeRange-''''''''''''
'Pulic Type pbShpRngCol
'''''''''-Paragraph-'''''''''''''
'Public Type ParagraphSet 'Para
'''''''''-Table-'''''''''''''
'Public Type pbTableSet 'Ts
'''''''''-TextFrame-'''''''''''''
'Public Type PbTextFrameset 'TF
'''''''''-TextRange-'''''''''''''
'Type PbTextRangeset 'TR
'''''''''-Field-''''''''''''' 'FlSet
'Public Type pbFieldSet
'''''''''-Font-'''''''''''''
'Public Type FontSetting 'FS
'''''''''-Story-'''''''''''''
'Public Type pbStroySet 'StSet
'''''''''-HyperLink'''''''''''''
'Public Type pbHyperlinksSet 'PHSet
'''''''''-Window-'''''''''''''
'Public Type pbWinSize
'///// Start Type Statements /////
'''''''''-Application-'''''''''''''
Public Type AppSet
Build As Long
InsertBarcodeVisible As Boolean
Language As Long
Path As String
PathSeparator As String
ScreenUpdating As Boolean
ShowFollowUpCustom As String
SnapToGuides As Boolean
SnapToObjects As Boolean
TemplateFolderPath As String
ValidateAddressVisible As Boolean
Version As String
WizardCatalogVisible As Boolean
End Type
'''''''''-Options-'''''''''''''
Public Type pbOptionsSet
AddHebDoubleQuote As Boolean 'Trueをヘブライ語のアルファベット番号を二重引用符を表示します。既定ではfalse を指定します。読み取り/書き込みブール値です。
AllowBackgroundSave As Boolean 'true。(既定値) を同時に他のアクションを実行できるように、バック グラウンドで文書を保存します。読み取り/書き込みブール値です。
AutoFormatWord As Boolean
AutoHyphenate As Boolean
AutoKeyboardSwitching As Boolean
DefaultPubDirection As PbDirectionType
DisplayStatusBar As Boolean
DragAndDropText As Boolean
HyphenationZone As Variant
MeasurementUnit As PbUnitType
PathForPictures As String
PathForPublications As String
SaveAutoRecoverInfo As Boolean
SaveAutoRecoverInfoInterval As Long
SequenceCheck As Boolean 'True系アジア言語のテキストの文字のシーケンスをチェックします。読み取り/書き込みブール値です。
ShowBasicColors As Boolean 'Microsoft Publisherのカラー パレットに基本色を表示するか
ShowScreenTipsOnObjects As Boolean 'マウス ポインターを置くときにポップ ヒントを表示します。ブール値です。
ShowTipPages As Boolean 'Trueバルーン ヒントを表示します。読み取り/書き込みブール値です。
TypeNReplace As Boolean 'Trueを無効なキーボード シーケンスによる読み取れないアジア系文字のクラスターを置き換えます。読み取り/書き込みブール値です。
UseCatalogAtStartup As Boolean '起動するときにカタログを表示するか。ブール値です。
UseWizardForBlankPublication As Boolean
End Type
'''''''''-Page-'''''''''''''
Public Type pbPageSet
Height As Single
Width As Single
IgnoreMaster As Boolean
IsTrailing As Boolean
IsWizardPage As Boolean
Name As String
PageID As Long
PageIndex As Long
PageNumber As String
PageType As PbPageType
XOffsetWithinReaderSpread As Single
YOffsetWithinReaderSpread As Single
End Type
'''''''''-ColorFormat-'''''''''''''
Public Type pbClrFmt
BaseCMYK As ColorCMYK '基本シアン、マゼンタ、黄-黒 (CMYK) では、 ColorFormatオブジェクトの親オブジェクトの値を色の濃淡の前に、色に網かけを設定または返します 読み取り専用
BaseRGB As MsoRGBType '色の濃淡を調整したり網かけを適用するなどして色を変更する前の、元の RGB 色の書式を表す
CMYK As ColorCMYK
Ink As Long
SchemeColor As PbSchemeColorIndex
TintAndShade As Single
Transparency As Single
Type As PbColorType
End Type
Public Type FillFmt
BackColor As ColorFormat
ForeColor As ColorFormat
GradientDegree As Single
GradientVariant As Long
Pattern As MsoPatternType
PresetGradientType As MsoPresetGradientType
PresetTexture As MsoPresetTexture
TextureAlignment As MsoTextureAlignment
TextureHorizontalScale As Single
TextureName As String
TextureOffsetX As Single
TextureOffsetY As Single
TextureType As MsoTextureType
TextureVerticalScale As Single
Transparency As Single
Type As MsoFillType
End Type
'''''''''-LanguageSettings-'''''''''''''
Public Type pbLanguageSettings
LanguageID As MsoAppLanguageID
LanguagePreferredForEditing As MsoLanguageID
End Type
'''''''''-Line-'''''''''''''
Public Type pbLineFormatSet
BackColor As ColorFormat
BeginArrowheadLength As MsoArrowheadLength
BeginArrowheadStyle As MsoArrowheadStyle
BeginArrowheadWidth As MsoArrowheadWidth
CapStyle As MsoLineCapStyle
DashStyle As MsoLineDashStyle
EndArrowheadLength As MsoArrowheadLength
EndArrowheadStyle As MsoArrowheadStyle
EndArrowheadWidth As MsoArrowheadWidth
ForeColor As ColorFormat
GradientAngle As Single
GradientColorType As MsoGradientColorType
GradientStyle As MsoGradientStyle
GradientVariant As Long
InsetPen As MsoTriState
JoinStyle As MsoLineJoinStyle
Pattern As MsoPatternType
PresetGradientType As MsoPresetGradientType
Style As MsoLineStyle
Transparency As Single
Type As MsoLineFillType
Visible As MsoTriState
Weight As Variant
End Type
Public pbLineFmtSet As pbLineFormatSet
'''''''''-Shape-'''''''''''''
Public Type pbShapeSize
Altext As String 'AlterNativText
BWmode As MsoBlackWhiteMode
l As Single
t As Single
w As Single
h As Single '2018/5/23 Change
End Type
'''''''''-ShapeRange-''''''''''''
Public Type pbShpRngCol
AlternativeText As String
AutoShapeType As MsoAutoShapeType
BCMode As MsoBlackWhiteMode
Callout As CalloutFormat
ConnectionSiteCount As Long
CNT As Long
HasTtbl As Boolean
HasTFrame As Boolean
Height As Single
HLink As Hyperlink
ID As Long
InlineAlignment As PbInlineAlignment
IsInline As MsoTriState
Line As LineFormat
Left As Single
Width As Single
Name As String
TextWrap As WrapFormat
WizardTag As PbWizardTag
Tags As Publisher.Tags
End Type
'''''''''-Paragraph-'''''''''''''
Public Type ParagraphSet
Ali As PbParagraphAlignmentType
AtT As Boolean 'AttachedTotext
CBFLIndent As Long 'CharBasedFirstLineIndent
FLIndent As Variant 'FirstLineIndente
KLT As MsoTriState 'KeepLinetogether
KWN As MsoTriState 'KeepWithNext
Lin As Variant 'LeftIndente
LS As Variant
LSR As PbLineSpacingRule
ListBulletFontName As String
ListBulletFontSize As Single
ListBulletText As String
ListIndent As Single
ListNumberSeparator As PbListSeparator
ListNumberStart As Long
ListType As PbListType
LockToBaseLine As MsoTriState
RightIndent As Variant
SpaceAfter As Variant
SpaceBefore As Variant
StartInNextTextBox As MsoTriState
TextDirection As PbTextDirection
TextStyle As Variant
End Type
'''''''''-Table-'''''''''''''
Public Type pbTableSet
cells As CellRange
Cols As Columns
GTFT As Boolean
Rs As Rows
TD As PbTableDirectionType
TA As PbTabAlignmentType
TAUFT As PbTableAutoFormatType
TAFT As PbTextAutoFitType
End Type
'''''''''-TextFrame-'''''''''''''
Public Type PbTextFrameset
AutoFitText As PbTextAutoFitType
Columns As Long
ColumnSpacing As Variant
HasNextLink As MsoTriState
HasPreviousLink As MsoTriState
HasText As MsoTriState
IncludeContinuedFromPage As MsoTriState
IncludeContinuedOnPage As MsoTriState
MarginBottom As Variant
MarginLeft As Variant
MarginRight As Variant
MarginTop As Variant
NextLinkedTextFrame As TextFrame
Orientation As PbTextOrientation
Overflowing As MsoTriState
Story As Story
VerticalTextAlignment As PbVerticalTextAlignmentType
End Type
'''''''''-TextRange-'''''''''''''
Type PbTextRangeset
BoundHeight As Single
BoundLeft As Single
BoundTop As Single
BoundWidth As Single
LanguageID As MsoLanguageID
Length As Long
LinesCount As Long
Script As PbFontScriptType
WordsCount As Long
End Type
'''''''''-Field-'''''''''''''
Public Type pbFieldSet
CodeStr As String 'Code
PhoneG As PhoneticGuide
RstStr As String 'Result
Trng As TextRange
Ty As PbFieldType
End Type
'''''''''-Font-'''''''''''''
Public Type FontSetting
isBld As Boolean ' bold
isiTa As Boolean ' Italic
LineF As LineFormat
N As String 'Name
Ns As PbNumberStylesType
P As Variant 'Position
Sz As Variant 'Font Size
isSmallcap As MsoTriState 'SmallCap
iStThrough As MsoTriState 'StrikeThrough 打消し線
isSubSc As MsoAlertButtonType 'Subscript
Trc As Variant 'tracking
TrPrSet As PbTrackingPresetType
UdLine As PbUnderlineType
End Type
'''''''''-Story-'''''''''''''
Public Type pbStroySet
HasTable As MsoTriState
HasTextFrame As MsoTriState
Type As PbStoryType
End Type
'''''''''-HyperLink'''''''''''''
Public Type pbHyperlinksSet
Address As String
EmailSubject As String
PageID As Long
TargetType As PbHlinkTargetType
TextToDisplay As String
Type As MsoHyperlinkType
End Type
'''''''''-Window-'''''''''''''
Public Type pbWinSize
l As Long
t As Long
w As Long
h As Long
End Type
'''''''''-PictureFormat-'''''''''''''
Public Type PicFormatSet
Brightness As Single
ColorModel As PbColorModel
ColorsInPalette As Long
ColorType As MsoPictureColorType
Contrast As Single
CropLeft As Variant
CropTop As Variant
CropBottom As Variant
EffectiveResolution As Long
Filename As String
FileSize As Long
HasAlphaChannel As MsoTriState
HasTransparencyColor As Boolean
Height As Variant
Width As Variant
HorizontalScale As Long
IsEmpty As MsoTriState
IsGreyScale As MsoTriState
IsLinked As MsoTriState
IsRecolored As MsoTriState
IsTrueColor As MsoTriState
LinkedFileStatus As PbLinkedFileStatus
OriginalColorsInPalette As Long
OriginalHasAlphaChannel As MsoTriState
OriginalHeight As Variant
OriginalWidth As Variant
OriginalIsTrueColor As MsoTriState
OriginalResolution As Long
TransparencyColor As MsoRGBType
TransparentBackground As MsoTriState
VerticalScale As Long
End Type
Public Type iColorRGB
R As Double
B As Double
G As Double
End Type
'For Color RGB Value Constitution
'Reffernce http://www.ozgrid.com/forum/showthread.php?t=49072
Public Const Max_ColorValue = 16777215
Public Const BLUE_OFFSET = 65536
Public Const GREEN_OFFSET = 256
Public Const RED_OFFSET = 1
Public Const ColVbBl = 16711680
Public Const ColVbR = 255
Public Const ColVBW = 16777215
Public Const ColVBB = 0
Public Const ColVBM = 16711935
Public Const ColVBC = 16776960
Public Const ColVBG = 65280
Public Const ColVBY = 65535
Public LFSt As pbLineFormatSet
'
' /// Functions Block
'
Function fnShapeTypeString(i as long) As String
'2018/4/8追加
Select Case i
Case Is = 1
shpTypeString = "pbAutoShape"
Case Is = 113
shpTypeString = "pbBarCodePictureHolder"
Case Is = 116
shpTypeString = "pbWebWebComponent" 'Web の Web コンポーネント
Case Is = 2
shpTypeString = "pbCallout"
Case Is = 111
shpTypeString = "pbCatalogMergArea"
Case Is = 3
shpTypeString = "pbChart"
Case Is = 4
shpTypeString = "pbComment"
Case Is = 8
shpTypeString = "pbFormControle"
Case Is = 5
shpTypeString = "pbFreeForm"
Case Is = 6
shpTypeString = "pbGroup"
Case Is = 118
shpTypeString = "pbGroupWizard"
Case Is = 10
shpTypeString = "pbLinkedOLEObject"
Case Is = 11
shpTypeString = "pbLinkedPicture"
Case Is = 12
shpTypeString = "pbOLEControlObject"
Case Is = 13
shpTypeString = "pbPicture"
Case Is = 16
shpTypeString = "pbMedia"
Case Is = -2
shpTypeString = "pbShapeTyepMixed"
Case Is = 9
shpTypeString = "pbLine"
Case Is = 15
shpTypeString = "pbTextEffect"
Case Is = 17
shpTypeString = "pbTextFrame"
Case Is = 7
shpTypeString = "pbEmbeddedOLEObject"
End Select
End Function
Public Function MtP(mm As Long)
MtP = Fix(Application.MillimetersToPoints(mm) * 10000) / 10000
End Function
Public Function Ptmm(ptSingle As Single) As Long
Ptmm = Fix(Application.PointsToMillimeters(ptSingle) * 10000) / 10000
End Function
Public Function xlRnd(i As Long, degit As Long)
Dim xlapp As Object: Set xlapp = CreateObject("Excel.Application")
xlRnd = xlapp.Worksheetfunction.Round(i, degit)
xlapp.Quit
Set xlapp = Nothing
End Function
Public Function xlFx(i As Double, idegit As Long)
Dim i1 As Long
Dim x As Double
If idegit >= 0 Then
x = 1
For i1 = 1 To Fix(idegit)
x = x * 10
Next
ElseIf idegit <= -1 Then
x = 1
For i1 = 1 To Abs(Fix(idegit)) - 1
x = x / 10
Next i1
End If
If x = 0 Then x = 1
xlFx = Fix(i * x + 0.5) / x
End Function
Public Sub lineformatpropertyset(Lineformatobject As LineFormat)
With Lineformatobject
On Error Resume Next
LFSt.BackColor = .BackColor
LFSt.BeginArrowheadLength = .BeginArrowheadLength
LFSt.BeginArrowheadStyle = .BeginArrowheadStyle
LFSt.BeginArrowheadWidth = .BeginArrowheadWidth
LFSt.DashStyle = .DashStyle
LFSt.CapStyle = .CapStyle
LFSt.EndArrowheadLength = .EndArrowheadLength
LFSt.EndArrowheadStyle = .EndArrowheadStyle
LFSt.EndArrowheadWidth = .EndArrowheadWidth
LFSt.ForeColor = .ForeColor
LFSt.GradientAngle = .GradientAngle
LFSt.InsetPen = .InsetPen
LFSt.JoinStyle = .JoinStyle
LFSt.Pattern = .Pattern
LFSt.PresetGradientType = .GradientColorType
LFSt.Style = .Style
LFSt.Transparency = .Transparency
LFSt.Type = .Type
LFSt.Visible = .Visible
LFSt.Weight = .Weight
End With
End Sub
Function rgbarray(colorvalue) As Collection
' この関数は、ユーザーによる入力内容を配列に挿入し、
' 配列を返します。
'Refference https://msdn.microsoft.com/ja-jp/library/cc376074.aspx
Dim astrItems As New Collection
Dim iRGB As iColorRGB
Dim Blue2Green As Long
Dim ar, br, i As Long
Dim strColorString As String
ar = Array(ColVBB, ColVBW, ColVbBl, ColVBM, ColVbR, ColVBY, ColVBG, ColVBC)
br = Array("Black", "White", "Blue", "Magenta", "Red", "Yellow", "Green", "Cyan")
If colorvalue > Max_ColorValue Then colorvalue = Max_ColorValue
For i = LBound(ar) To UBound(ar)
If ar(i) = colorvalue Then strColorString = br(i): Exit For
Next i
'Caluculate RGB Color Number
iRGB.B = Fix(colorvalue / BLUE_OFFSET)
Blue2Green = colorvalue - (iRGB.B * BLUE_OFFSET)
iRGB.G = Fix(Blue2Green _
/ GREEN_OFFSET)
iRGB.R = Blue2Green - (iRGB.G * GREEN_OFFSET)
'End:Caluculate RGB Color Number
astrItems.Add (iRGB.R)
astrItems.Add (iRGB.B)
astrItems.Add (iRGB.G)
astrItems.Add (strColorString)
Set rgbarray = astrItems
If Not astrItems Is Nothing Then Set astrItems = Nothing
End Function
以下(1)～(3)までの記事のスクリプトをコピペしたらマクロつきのPublisher個人用テンプレートとして保存してください。拡張子はpubで変わりません。
Publsiher VBA 今回の想定使用状況
うことで、需要のないスタートセットを載せます。
この場合のPublisherは現在の使用でWebページを作成したりすることはなく、チラシ作成用です。
PublisherとPowerointはよく似ています。手でオブジェクトを置いていきますが、オブジェクトが微妙にずれる事態が起きます。
そうしたときにまずプロパティを参照したりします。
これがPublisherのVBAの使用の始まりです。
したがってShapeのプロパティを調べたり変更したりするのが主な役目です。
なれると様式を作れたりします。
Type宣言と必須関数
Pulisherは実は中身がポイントで単精度です。
関数millimeterTOPointがありますが、これをそのまま使うと、微妙にずれます。
Excelの演算誤差と同じ現象です。
したがって、適宜誤差をカットした方が良いです。
これは各自で調整するとして、スタンダードなものは1万分の1くらいあればいいでしょう。
また。PulisherのVBAはほぼすべて図形を使います。
ということは1オブジェクトに必ず左、うえ、幅、高さ、が基本的にあります。
これを一つ一つ指定するとわけがわからなくなります。
そこでType宣言を使います。
複数のモジュールの時はPublicにしてください。
以下の例は別のモジュールに入れて動くようにPublic宣言しています。
Type宣言したもの
''''Type Set List ''''
'''''''''-Application-'''''''''''''
'Public Type AppSet(2017/5/8追加)
'''''''''-Options-'''''''''''''
'Public Type pbOptionsSet(2017/5/8追加)
'''''''''-Shape-'''''''''''''
'Public Type pbShapeSize ' Ss
'''''''''-ShapeRange-''''''''''''(2017/4/8追加)
'Pulic Type pbShpRngCol
'''''''''-Paragraph-'''''''''''''
'Public Type ParagraphSet 'Para
'''''''''-Table-'''''''''''''
'Public Type pbTableSet 'Ts
'''''''''-TextFrame-'''''''''''''
'Public Type PbTextFrameset 'TF
'''''''''-TextRange-'''''''''''''
'Type PbTextRangeset 'TR
'''''''''-Field-''''''''''''' 'FlSet
'Public Type pbFieldSet
'''''''''-Font-'''''''''''''
'Public Type FontSetting 'FS
'''''''''-Story-'''''''''''''
'Public Type pbStroySet 'StSet
'''''''''-HyperLink'''''''''''''
'Public Type pbHyperlinksSet 'PHSet
'''''''''-Window-'''''''''''''
'Public Type pbWinSize
説明
pbWinSize 窓用 あまり今は使わない
pbStroySet ストーリーオブジェクト用
一番使うもの
pbShapeSize Shapeオブジェクト(一番よく使う）
PbTextFrameset
PbTextRangeset
ParagraphSet
fontSetting
pbTableSet テーブル（表）
Publisherは
Document Page Shpaes Shape Textframe Textrange Paragraph text
Field
というオブジェクトの順番になっていますので、このようにオブジェクトをセットします。
あとParagraphからさらに箇条書きがあります。
また縦書きにした場合、数字を横並びにするのを縦中横といいます。
この時Filedオブジェクトというのが作られてその中に横並びにした文字が入ります。
Type宣言の使い方は
たとえばPbShpesizeはよく使うと思います
なので
Dim ss As pbHaplesize
のように宣言するとss.のあとにどんどんプロパティが立ち上がります。
Publisherの設定について(2017/5/8追加)
Publisherの設定はApplicationとApplication.Optionsの２つに記載されています
関数について
fnShapeTypeString
ShapeTypeの定数の文字列を返す関数です。
Public Function MtP(mm As Long)
これは非常によく使うことになります。ミリメーターをポイントに変えます。
しかしこれをそのまま使うと演算誤差で次第にずれていきます。
そこで端数処理が必要になるのです。
必要に応じて正数位にする数を変えます。また、切り捨てになっています。
こっちの方があっていると思う。
Public Function Ptmm(ptSingle As Single) As Long
ポイントをミリメーターに変えます。
プロパティを出しても単位がポイントのままでよくわからないのでこちらで変換します。
Public Function xlRnd(i As Long, degit As Long)
PublisherはRound関数がないため、四捨五入をするため、Excelを呼び出しています。
xlRnd(16,45,1)で16.5が返ります。
これは非常用で重いのであまり使えません。
ユーザ定義関数の検証等に作りました。
Public Function xlFx(i As Double, idegit As Long)
Excelの四捨五入と大体同じ動きをします。