Publisher VBA 縦中横 を実行して数字を並べるマクロ

設定

小ラベル16枚
各々がグループ化されている
それ以外のシェイプはない
各々のテキストはフォントサイズ13 Calibrに設定済み
ここに　47から60までの数字をいれたい。
いれるのは現在のラベルのみ
ラベルには現在横倒しにした数字し
か入らない
---- ----

44 44

---- ----
ではなく

---- ----
__
+|-- +|--
\ __ ___
+|-- +|--

---- ----
と入る状態。
ラベルの状態は左側が上で横が長い（つまり縦長が左に90度回転している）
縦にすると数字は完全に上下逆になっている。

Sub test()
application.ActiveDocument.PageSetup.PageHeight =283.4646
application.ActiveDocument.PageSetup.PageWidth =419.5276
'left Margin top Margin VerticalGap Empty
Const StartNumber As Long = 61
Dim pbDoc As Publisher.Document: Set pbDoc = ThisDocument ’現在のPublisher のドキュメントに固定（最も同時に起動できないのでなくてもよい）
Dim pbWin As Publisher.Window: Set pbWin = Publisher.Application.ActiveWindow
Dim pbPage As Publisher.Page: Set pbPage = Publisher.ActiveDocument.ActiveView.ActivePage '現在アクティブなページの指定
Dim shp As Publisher.Shape, shps As Publisher.Shapes: Set shps = pbPage.Shapes 'PublisherのShapeはページ単位でコレクションになる
Dim pbPara As ParagraphFormat
Dim pbGrs As Publisher.GroupShapes
Dim buf As String
Dim rngTemp As TextRange
Dim fldTemp As Field
Dim i As Long
Dim cnt As Long
cnt = StartNumber
For Each shp In shps
With shp
For i = 1 To 2
.GroupItems.Item(i).TextFrame.TextRange.Text = ""
.GroupItems.Item(i).TextFrame.TextRange.Text = CStr(cnt)
With .GroupItems(i)
Set rngTemp = .TextFrame.TextRange.InsertAfter(cnt)
Set fldTemp = .TextFrame.TextRange.Fields _
.AddHorizontalInVertical(Range:=rngTemp, Text:=CStr(cnt))
rngTemp.Characters(1, 1).Select
.TextFrame.TextRange.Characters(1, Len(cnt) / 2).Select 'なぜか縦書きになった文字をカウントするので2でわる
Selection.TextRange.Delete

End With
Next
End With
cnt = cnt + 1
Next
End Sub

ポイント

1. アクティブなページの指定方法は Set pbPage = Publisher.ActiveDocument.ActiveView.ActivePage
2. タックインデックスは裏表があるので、その2つの枠がグループ化されていると、GroupShapesオブジェクトになる。
3. このGroupShpesのItemが各テキストボックス（テキストレンジ）になる
4. テキストレンジのクリアは=""で縦中横にした字も消えてしまう。
5. テキストレンジにrangetempというテキストレンジ(変数rangetemp)を追加(Insert)し、フィールドの追加という形で縦中横の文字を追加する。
6. なのでVBA上ではまずダミーの文字を追加して、そのあとにフィールドを追加した。
7. そのうえでダミーの文字列を消すのだが、なぜかrangetempに元の文字が入っていることになっているので、Charactaes(1,2) を指定。1文字目から2文字分という意味になる。
8. ただしこれだと桁数が増えると対応できないのでLen(buf)/2で文字数を変える。
9. なぜかフィールドの文字も数えるのでLenbufは4文字と2倍カウントするので2で割る。

Publisherのテキストボックスへの文字を入れる方法

• Documents - Document - View- Page - Shapes - TextFrame - TextRange- Text = "Hello World!" というオブジェクトのつながりがある。 公式TextFrame オブジェクト (Publisher)のこれが代表的。

AddTextToTextFrame

Sub AddTextToTextFrame() 
 With ActiveDocument.Pages(1).Shapes(1).TextFrame.TextRange 
 .Text = "Hello World!" 
 With .Font 
 .Bold = msoTrue 
 .Size = 25 
 .Name = "Arial" 
 End With 
 End With 
End Sub

しかし今回は２つのShapeがグループ化されているのと縦中横がフィールドなので
Shaple - GroupShapes - Item(1) - TextFrame - TextRange - Text
- TextRange - Fields-field

縦中横について

読み方：たてちゅうよこ
この場合の縦中横とはフォントを縦書きの中で横に並べることをいう。
これはテキストボックス（Publisherでは厳密に言うとTextFrameのはず）自体を回転させる方法とにているので大変紛らわしい。
英語では Horizontal In Vertical
Make text vertical
テキストを縦書きにする
これは違う。

Fields.AddHorizontalInVertical Method (Publisher)
Fields.AddHorizontalInVertical メソッド (Publisher)
今回用いたのはこれである。
AddHorizontalInVertical Method [Publisher 2003 VBA Language Reference]
2003から存在する手法