Illustrator Script PDF互換オプションを有効にして保存する

Adobe Bridgeを使ってIllustratorの大量のイラストデータを管理する際，

PDF互換オプションがオンになっていないものはサムネイルが崩れたり，または見えなかったりするので，

管理にかなり困る。というか，サムネイルが見えない画像はお蔵いり決定なので由々しき問題。

私は，IllustACというサイトのプレミアム会員で，デジタル配布教材に補足するための図に使えるように

そこで大量のイラスト画像をダウンロードしてます。

量が少ない時は　別名保存の時オプションにチェック入れるだけですが，多いとかなり・・(;´▽｀A``

なので，そういうとき用のスクリプト。拡張子jsxで保存してIllustratorのスクリプトから使います。

特定のフォルダ内の .ai .eps　全部に適用するときはこれ

//フォルダ選択
var folderObj = Folder.selectDialog("ai,epsファイルのあるフォルダを選択してください") ;
//保存先を選択 デフォルトに同じフォルダを設定
var saveObj = decodeURI(Folder.selectDialog("保存先のフォルダを選択してください",folderObj) );
var saveObj = saveObj + "/" ; 
//aiとepsのリストを作成
var fileListAI = folderObj.getFiles("*.ai") ; 
var fileListEPS=folderObj.getFiles("*.eps");
var fileList=fileListAI.concat(fileListEPS);
//保存時のオプション設定
var aiOptions = new IllustratorSaveOptions; 
with (aiOptions) { 
    pdfCompatible = true ; //PDF互換ファイルを作成
    embedICCProfile = false ; //ICCプロファイルを埋め込まない
    compressed = true ; //圧縮を使用
}

for (i = 0; i < fileList.length ; i ++) {
    app.open(fileList[i]) ;
    var  docObj=app.activeDocument
    var aiName = docObj.name.split(".")[0] ; 
    var saveFile = new File(saveObj + aiName + ".ai");
    docObj.saveAs(saveFile, aiOptions);
    docObj.close() ;
}

全部じゃなくて，複数選択した状態で使うように組んだのがこれ

//フォルダ選択
var fileList = File.openDialog("PDF互換を作成したいファイルを選択してください。","*.ai;*.eps",true);
//保存先を選択 デフォルトに同じフォルダを設定
var folderObj=fileList[0].path;
var saveObj = decodeURI(Folder.selectDialog("保存先のフォルダを選択してください",folderObj) );
var saveObj = saveObj + "/" ; 

//保存時のオプション設定
var aiOptions = new IllustratorSaveOptions; 
with (aiOptions) { 
    pdfCompatible = true ; //PDF互換ファイルを作成
    embedICCProfile = false ; //ICCプロファイルを埋め込まない
    compressed = true ; //圧縮を使用
}

for (i = 0; i < fileList.length ; i ++) {
    app.open(fileList[i]) ;
    var  docObj=app.activeDocument
    var aiName = docObj.name.split(".")[0] ; 
    var saveFile = new File(saveObj + aiName + ".ai");
    docObj.saveAs(saveFile, aiOptions);
    docObj.close() ;
}

複数のファイルを選択して，それに対して作業をする，というときのためにこのコードは残しますが，

エクスプローラーのサムネイルではPDF互換はたいして意味を成しませんでした。

なので，二番目のコードは使えないもの(;´▽｀A``

File.openDialogの使い方のメモとして載せるだけです。

自分用なので，ちゃんと動かなくても悪しからず・・(;´▽｀A``

Javascriptは自分には難しいですが，少しずつやる。。

スライドショー中にペンを使うためのボタンマクロ

パワーポイントでマクロを組み始めるきっかけになった，職場の後輩から教えてもらったボタンのことを不意に思い出しました。

当時OneNoteがまだまだ，仕様不明な状態で，それでも書き込みをできる環境を，とパワーポイントで電子黒板と向かったときのことです。

でも，ボタンをいちいちコピーするの面倒だなぁと思い，結局あまり使うことが無かったのですが，

その仕組みはいいものだよなぁと今でも思い出せるので，ボタンを作るマクロをばたばたと作ってみました。個人的に懐かしいものです。(ﾟ▽ﾟ*)

Const Xsize = 10
Const Ysize = 10

Sub 各スライドにボタン設置()
    ActivePresentation.SlideShowSettings.Run.View.PointerType = ppSlideShowPointerArrow
    Dim s As Slide, i As Long
    On Error Resume Next
    For Each s In ActivePresentation.Slides
        For i = 1 To 7
            s.Shapes("DrawPointer" & i).Delete
        Next
        ボタン設置 (s.SlideIndex)
    Next
    On Error GoTo 0
End Sub

Sub ボタン設置(SlideIndex As Long)
    
    Dim xpos As Long, ypos As Long, 補正 As Long
    With ActivePresentation.SlideMaster
        xpos = .Width - Xsize * 9
        ypos = .Height - Ysize
    End With
    
    補正 = 0
    
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer1"
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "消しモード"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        .TextFrame.TextRange.Text = "E"
        .TextFrame.TextRange.Font.Size = 6
        .TextFrame.TextRange.Font.Color.RGB = rgbBlack
        補正 = 補正 + Xsize
    End With
    
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer2"
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "描画1"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        補正 = 補正 + Xsize
    End With
    
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer3"
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "描画2"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        補正 = 補正 + Xsize
    End With
            
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer4"
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "描画3"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        補正 = 補正 + Xsize
    End With

    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer5"
        .Fill.ForeColor.RGB = RGB(0, 0, 255)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "描画4"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        補正 = 補正 + Xsize
    End With
        
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer6"
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "描画5"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        補正 = 補正 + Xsize
    End With
        
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer7"
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "ポインタ"
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        .TextFrame.TextRange.Text = "P"
        .TextFrame.TextRange.Font.Size = 6
        .TextFrame.TextRange.Font.Color.RGB = rgbBlack
        補正 = 補正 + Xsize
    End With
        
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer8"
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .ActionSettings(ppMouseClick).Action = ppActionPreviousSlide
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        .TextFrame.TextRange.Text = "←"
        .TextFrame.TextRange.Font.Size = 6
        .TextFrame.TextRange.Font.Color.RGB = rgbBlack
        補正 = 補正 + Xsize
    End With
    
    With ActivePresentation.Slides(SlideIndex).Shapes.AddShape(msoShapeRectangle, xpos + 補正, ypos, Xsize, Ysize)
        .Name = "DrawPointer9"
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .ActionSettings(ppMouseClick).Action = ppActionNextSlide
        .ActionSettings(ppMouseOver).Action = ppActionRunMacro
        .ActionSettings(ppMouseOver).Run = "ポインタ"
        .TextFrame.TextRange.Text = "→"
        .TextFrame.TextRange.Font.Size = 6
        .TextFrame.TextRange.Font.Color.RGB = rgbBlack
    End With

End Sub


Sub 描画モード(色1 As Long, 色2 As Long, 色3 As Long)
    With ActivePresentation.SlideShowSettings.Run.View
        .PointerColor.RGB = RGB(色1, 色2, 色3)
        .PointerType = ppSlideShowPointerPen
    End With
End Sub

Sub ポインタ()
     ActivePresentation.SlideShowSettings.Run.View.PointerType = ppSlideShowPointerArrow
End Sub

Sub 消しモード()
     ActivePresentation.SlideShowSettings.Run.View.PointerType = ppSlideShowPointerEraser
End Sub

Sub 描画1()
    Call 描画モード(0, 0, 0)
End Sub

Sub 描画2()
    Call 描画モード(255, 0, 0)
End Sub
Sub 描画3()
    Call 描画モード(0, 255, 0)
End Sub
Sub 描画4()
    Call 描画モード(0, 0, 255)
End Sub
Sub 描画5()
    Call 描画モード(255, 255, 255)
End Sub

適当に作ったので，あまり細かいことは考えていませんが，

　　各スライドにボタン設置

を実行すると，その時あるすべてのスライドの右下にちっちゃいボタンをたくさん作ります。

E　は消しゴム
色　はその色のペンになる
P はポインタに戻すためのボタンだったんですが，いちいちそれ触らないと色を変えれなかったので，ボタン群の上を通るとポインタに勝手に戻ります。
←→はスライドの移動です。

コード見ればすごい単純なので，必要な数のボタンを必要な大きさで作れば役に立つ層もあるかもしれません。

MouseOverでポインタに勝手に戻るのがむしろ面倒な場合はその部分をコメントアウトしてもらえれば。。

最初これは　クラスモジュールで作り始めてみてたんですが，ActionSettingからクラスモジュール内のメソッド等にアクセスできる気がしなかったので，

標準モジュール上で遊んで終わることになりました。

きちんと作ればFor　Nextと配列でスマートに作れるんでしょうけど，気分で作ったのでコピペ全開です( ´ー｀)

挿入→動作→マクロ からの挙動 忘れてたので覚書

ひさびさにやると，いつも忘れてるので細かいこともメモ。

あれ，なんでだったっけ?と数日前になったので(;´▽｀A``

パワーポイントでは　図形にマクロを設定していろんなものをボタンにできます。

やり方は簡単。ボタンにしたい図形を選んでおいて　メニューから　　挿入　→　動作　→　マクロの実行　

のところに，そのボタンで実行したいマクロを選ぶだけ。

とてもシンプル。

・・・

パワーポイントではスライドを安定して動かすことが最重要項目なんでしょうね。

この時マクロにエラーがあると，何も言わずにマクロが止まるみたい。

Sub エラーなし1()
    MsgBox ("エラーなし")
End Sub

Sub エラーあり1()
    MsgBoxx ("エラーあり")
End Sub

Sub エラーなし2引数必要(shp As Shape)
    MsgBox (shp.Name)
End Sub

Sub エラーあり2引数必要(shp As Shape)
    MsgBoxx (shp.Name)
End Sub

なんの変哲もないマクロを用意して試してみる。

エラーあり1は　MgsBoxx xが多すぎなので当然ちゃんと動かないんですが，このマクロを 挿入→動作→マクロの実行　のところに貼り付けて，ボタンを押してもなんにも答えてくれない。

マクロが動いてるかどうかすらわからない

長いマクロだと　まったくエラーがわからないことになり，困ります。

どうやってチェックすればいいかというと・・・

開発　→　マクロ　から実行するか， VBEditorから実行すればちゃんとエラーは教えてくれる。

パワーポイントのマクロいじる上で忘れないほうがいい仕様なのかもしれません。

引数があるマクロの場合は実行できないので

Sub エラーあり2引数必要(shp As Shape)
    MsgBoxx (shp.Name)
End Sub

これを

Sub エラーあり2引数必要() 'shp As Shape)
    Dim shp As Shape: Set shp = ActivePresentation.Slides(1).Shapes(1)
    MsgBoxx (shp.Name)
End Sub

のように引数に具体的に何かいれてデバッグしてみるしかないのかな。。

そういえば以前そうしていたような気がする。。

だめですね，やらないと忘れるなぁ(;´▽｀A``

図を入れる余裕がないので，何言ってるかわからないことを書いてますが，自分用メモということでこれでおしまい(;´▽｀A``

(・・?

何日ぶりかのログイン(・_・;)

生きてはいます。ただ，VBAだけじゃだめかなぁというのと，Adobeのソフトをちまちま使い始めているので，そのスクリプト言語としてJavascriptを勉強中。

Adobe Animateのためにも必要かなぁと。。

さっぱりですけどね。。Illustrator用にネットで探したスクリプトを，少しずつ自分好みに書き換えたりすることから始めているところです。

VBScriptもAdobeのスクリプトを書くのには使えますが，そちらはVBAとかなり似てるので，今はJavascriptが理解できるよう努力しているところ。。

ですがこれから書くのはVBA

パワーポイントで以前自分で作ったものに，フォント選択のコンボボックスを入れたいと思いました。

Excelではけっこう簡単にやれます。

Sub test()
    Dim cb As CommandBarComboBox: Set cb = Application.CommandBars("Formatting").Controls(1)
    Stop
End Sub

こう書いてローカルウィンドウを見るとListCountが増えているので，ちゃんとフォント一覧取れそうだなぁと思える。

Powerpointでもきっといけると思い々コードでやってみました。Versionは2016 (Office365)です。

フォント一覧が取れていないことがわかります。

ナンデダ　(・_・;)

WordではControlsのインデックスが少しずれるけど，修正したらちゃんと取得できたんですよね。。Wordは

Sub test()
    Dim cb As CommandBarComboBox: Set cb = Application.CommandBars("Formatting").Controls(3)
    Stop
End Sub

これで取得できているようでした。むー。

愚痴を書きに来ただけです。。解決できませんでした。

追記　とりあえずごり押し PowerpointからExcelへの参照設定を入れて書いてます。

Sub test()
    Dim xl As New Excel.Application
    Dim cb As CommandBarComboBox
    Dim a() As String
    'PowerpointだけでできなかったのでExcelを利用
        xl.Workbooks.Add
        Set cb = xl.Application.CommandBars("Formatting").Controls(1)
        ReDim a(cb.ListCount)
        Dim i
        For i = 1 To cb.ListCount
            a(i) = cb.List(i)
        Next
        xl.Quit
    Stop
    
End Sub

強引ですが，手段は後に選ぼう(;´▽｀A``

Wordつづき(2)

あいかわらずWordで悪戦苦闘しています。ほんっとわかりません(;´▽｀A``

でもまだあきらめません。使いこなせればとてもいいものとわかっている以上もうすこし食い下がる。。

さて，個人情報を含まない形で作成中のファイルをもってきたので，それで試してみました。

shapeのduplicateメソッドは使うこととしました。
ページ指定をparagraphsであつかうのはばかげているので，そのへんを必死にさがしていたら

Word VBA 簡易リファレンス及び使用例(VB6.0) - VBレスキュー(花ちゃん)

こちらでいい情報が書いてありました。 GoToメソッドはrangeオブジェクトを返すらしいじゃないですか。
なのでたとえば２ページ目を指定したい場合は

ドキュメントオブジェクト.GoTo(wdGoToPage,wdGoToAbsolute,2)

と書ける。そしてrangeオブジェクトってことはそのままPasteつけれるじゃないか(/・ω・)/

無知なわたしとしては，この情報は歓喜に値するもの。まさにこれがほしかった。

ページ内ではleftやtopプロパティ，または絶対位置を指定するそれに類するものでなんとでもなる。

ページ移動で苦闘していたので，光が見えた気がします。

それでやりなおしたのがこのコード
今回はExcelからの流し込み部分に興味ないのでそのへんは除かれまたはコメントアウトしています。
必要なページ数はマクロでやるんじゃなく，マクロ実行する前にctrl+enterで先に確保しておく想定です。

Sub 名簿作り()
    Application.ScreenUpdating = False
    'Dim EX As Excel.Application, WB As Excel.Workbook, DataArray As Variant
    'Set EX = New Excel.Application
    'Set WB = Workbooks(ThisDocument.Path & "\H30名簿データ.xlsx")
    Dim NewDoc As Document: Set NewDoc = Documents.Add(Template:=ThisDocument.FullName)
    
    Dim Shp(1 To 9) As Shape, TableName As Variant, i As Long
    TableName = Array("dummy", "1組", "2組", "3組", "4組", "5組", "6組", "7組", "8組", "9組")
    
    Set Shp(1) = NewDoc.Shapes("元")
    Shp(1).Name = TableName(1)
    
    For i = 2 To 9
        Set Shp(i) = Shp(1).Duplicate
        Shp(i).Name = TableName(i)
    Next
    
    For i = 1 To 5
        Shp(i).Left = 180 * (i - 1)
    Next
    For i = 6 To 9
        Shp(i).Select: Selection.Cut
        NewDoc.GoTo(wdGoToPage, wdGoToAbsolute, 2).Paste
        Shp(i).Left = 180 * (i - 6)
    Next

End Sub

表はこんな感じです。１つだけ準備して"元"という名前を付けています。
５５行４列　一つ調整するだけでもWordはけっこう反乱を起こしますがこれが９クラス分となるとどれだけWordがいらいらする相手になるか想像できるもの(;´▽｀A``

マクロ実行前

マクロ実行後

データ流し込んだりは，個人情報の関係で職場でしかできません。テストデータを用意するのはめんどくさい(;´▽｀A``あとは切り取り線も用意したりするかなぁ。

とにかく，それっぽく動き出した。。

捕足
Wordは画面更新させながらマクロを動かすと，かなり表示に力を注いでいるのでScreenUpdatingはFalseにしました。

Array関数で名前のリストを作っていますが，ダミーを0番目にいれることで１スタートできるよう調整するようになりました。

まずDuplicateメソッドで増やした後，移動させるというように整理しました。

２ページ目に移す奴はカット&ペーストで処理するようにしました。

だいぶ　いやなところは減りました。

引き続き取り組んでいこう。

WordVBA つづき

前回の続きです。Wordの１ページ内での制御は簡単ですが，複数のページにまたがる場合は大変面倒でした。

今のところはまだ限定的ですが，練習を繰り返して力をつけていきたいものです。

どんな文書でもいいので，　"元"という名前の図形をつくって，下記のコードを試します。後で使うために Excelで　"データ"というブックを開いている前提での話となります。
Excelとの連携の方法にもいろいろあるんですが，わたしの職場のように自動暗号化される環境ではWorkbooks.Open等が使えない場合がありますので，そういうときの場合のためにすでにWordとExcelで
使う文書を開いた状態で使う，という状況を想定

Sub test()

Dim EXApp As Excel.Application, WB As Excel.Workbook
Set EXApp = GetObject(, "Excel.Application")
Set WB = EXApp.Workbooks("データ.xlsx")

Dim NewDoc As Document
Set NewDoc = Documents.Add(Template:=ThisDocument.FullName)

Dim Shp(1 To 6) As Shape, NameArray As Variant
NameArray = Array("いち", "に", "さん", "よん", "ご", "ろく")

NewDoc.Shapes("元").Select: Selection.Copy
NewDoc.Characters.Last.InsertBreak wdPageBreak
NewDoc.Paragraphs(1).Range.Paste
NewDoc.Paragraphs(2).Range.Paste


Set Shp(1) = NewDoc.Paragraphs(1).Range.ShapeRange(1)
Shp(1).Name = "Shp1"
Dim i As Long
For i = 2 To 3
    Shp(1).Select: Selection.Copy
    NewDoc.Paragraphs(1).Range.Paste
    Set Shp(i) = NewDoc.Paragraphs(1).Range.ShapeRange(i)
    Shp(i).Name = "Shp" & i
    Shp(i).Left = Shp(i - 1).Left + 200
Next

Set Shp(4) = NewDoc.Paragraphs(2).Range.ShapeRange(1)
Shp(4).Name = "Shp4"
NewDoc.Paragraphs(2).Range.Select
For i = 5 To 6
    Shp(4).Select: Selection.Copy
    NewDoc.Paragraphs(2).Range.Paste
    Set Shp(i) = NewDoc.Paragraphs(2).Range.ShapeRange(i - 3)
    Shp(i).Name = "Shp" & i
    Shp(i).Left = Shp(i - 1).Left + 200
Next


End Sub

もっとスマートに書きたいものですが，Duplicateでやると，パラグラフ(2)での処理に失敗してしまいましたので，嫌いなコピペでの操作です。
できればいいんだまずは(;´▽｀A``

実行すると，"元"の図形を１ページ目に３つ　２ページ目に３つつくります。
それぞれShp1～Shp6という名前に変更していて，Shp(i)という変数に収納しています。

なので，前回のコードをあとは絡めれば，Excelのデータからそれぞれの図にデータを流し込んでいけることになる。
１つ一生懸命きれいに作り上げればそれをひな型にどんどん増やせるよ，というコードにしているつもりです。

いろんなことを考えているのでNameArrayというのも今は使っていませんが準備しています。For Nextで回す時になにかつかえるように，と。

あとは，Documents.Add でテンプレートとして使う，という書き方をするのも気に入ってます。イイ書き方ですね。調べているときにどこかで見させてもらったものを流用しています。

Excelでも同じような書き方あるのかなぁ。。

少しずつWordVBAを自分好みに使うよう遊んでいるところです。

異体字に負けにくいWordでの話。

フォントに含まれる字はアプリケーションに依存しないで表示・印刷できると今まで信じていましたが，違うことに今日困らされました。

環境依存文字ったって，Officeでは共通して使えるだろうと思ってましたが，Wordでは出るけどExcelでは出ないとかPublisherでは出るとか，いろいろ。。

Excelがそういう面では汎用性は良くなく，wordがそういうときは強いなぁと感心しながら作ってましたが，

360名分の名簿を表に入れてWordで手動でいじってると　重たい重たい(;´▽｀A``

家で試したら，職場で思ったほどの差はなく，365と2016の違いがあるのかなぁと悩みどころでもあるんですが，外字が使えない職場ではそれなりに戦うしかありません。

軽さではPublisherも惹かれました。レイアウトも崩れにくいし，VBAもexcel,word,powerpointのVBAで遊んでいたせいか，すんなり制御できそう。

ただPublisherというだけで引く人もいる職場です。他のに比べれば私らの職場ではマイナー。

なのでWordの制御をしてみました。

重くなる原因でもありますが，レイアウトフリーでWord上に多数の表を貼り付ける場合，テキストボックスをまず入れて，その中にテーブルを入れてということをします。

テキストボックスに Txt1 という名前をつけて，その中に表を二つ入れている状態で制御した例です。

そういうときの，テキストボックス内のテーブルにアクセスするコードは書いたことが無かったのでとても新鮮でした。

Sub a()

    Dim TBL1 As Table, TBL2 As Table
    With ActiveDocument.Shapes("Txt1").TextFrame.ContainingRange
        Set TBL1 = .Tables(1)
        Set TBL2 = .Tables(2)
    End With

    TBL1.Rows(1).Cells(2).Range.Text = "5"
    
    TBL2.Rows(2).Cells(1).Range.Text = "6"
Stop

End Sub

いつも雑でStopなんかも入れっぱなしですがこんな感じでアクセス可能でした。

ContainingRangeってのは初めて見ましたね。

マクロで表のテンプレートをどんどんコピーして(Duplicateでいけました)座標も調整して，データをExcelから流し込んで，とやってみると，

Excelの苦手分野である印刷と画面表示が違うという困難を乗り越えられる感触が得られました。

Wordで書式を与えられると，Excelで作り直して・・・とされている方々はWordのVBAもやってみることをお勧めしたいと思います。

だいぶ制御できるようになり，とても仕事が楽になったなぁと思う今日この頃です。

ContainingRangeの備忘録として書きました。

テーブルにアクセスするときは

TBL1.Cell(1, 3).Range.Text = "4"

こういう書き方のほうが，Excelやpowerpointに近いですね。
なぜか上では違う書き方をしてしまった。適当さが出てしまう(;´▽｀A``