この1ヶ月半ほど、イベントの手伝いをしていました。その中で、名札の作成に関わってまして、またまたマクロが活躍しました。
以前紹介した「【コード】1行に収まるようフォントサイズを縮小する」を応用して、差し込み印刷機能で作成した名札を自動で修正するマクロをつくってみました。
名札が数百枚もあるような場合に便利だと思います。
このマクロでできること
差し込み印刷機能を使うと、名前や会社名を自動的に名札に挿入できます。
そのときに、文字数が多すぎて複数行になってしまう箇所だけ、文字サイズを小さくしてその項目を1行に収めます。
文書中の「メイン文書」箇所のみ実行できます。
差し込み印刷の文書
結果の表示
差し込んだ結果をWord文書にします。
マクロ実行前
会社名が長いと改行されてしまいかっこわるい!会社名は特に注意が必要です。
マクロ実行後
1行に収まります。めでたしめでたし。
マクロの解説
文書中のすべての段落について処理をしたいので、For Each…Loopステートメントを使っています。
ステータスバーにプログレスバーを表示しています。
「【コード】1行に収まるようフォントサイズを縮小する」のコードを、今回実務で使ってみて使いづらいところがあったので少し修正しました。
マクロ
Sub 段落を1行に収めるマクロ2() Dim myPara As Paragraph Dim i As Long Dim iMax As Long Dim objUndoRec As UndoRecord '------------------------------------------- 'Undoで一回で元に戻す設定(Word 2010以降対応) '------------------------------------------- Set objUndoRec = Application.UndoRecord objUndoRec.StartCustomRecord "段落を1行に収める" iMax = ActiveDocument.Paragraphs.Count i = 1 For Each myPara In ActiveDocument.Paragraphs Call Process(myPara.Range) i = i + 1 Application.StatusBar = _ "処理中..." & _ String((CInt(i / iMax * 10)), "■") & _ String(10 - CInt(i / iMax * 10), "□") Next '------------------------------------------- 'Undoで一回で元に戻す設定(Word 2010以降対応) '------------------------------------------- Application.ScreenRefresh DoEvents objUndoRec.EndCustomRecord Set objUndoRec = Nothing MsgBox "終了しました。" End Sub Private Sub Process(myRange As Range) Dim LineStart As Long '先頭の文字の行番号 Dim LineEnd As Long '末尾の文字の行番号 '段落末尾の改行記号を除外 myRange.End = myRange.End - 1 'ソフトリターンがあれば除外 If InStr(1, myRange.Text, vbVerticalTab) > 0 Then Exit Sub End If '行内配置図があれば除外 If myRange.InlineShapes.Count > 0 Then Exit Sub End If '文字がなければ除外 If myRange.Start = myRange.End Then Exit Sub Else '先頭文字の行番号を取得 LineStart = myRange.Information(wdFirstCharacterLineNumber) '末尾文字の行番号を取得 LineEnd = myRange.Characters.Last.Information(wdFirstCharacterLineNumber) Do While LineStart <> LineEnd If myRange.Text = "" Then Exit Do Else 'フォントサイズが1の場合には段落を明るい緑色で着色 If myRange.Font.Size = 1 Then myRange.HighlightColorIndex = wdBrightGreen Exit Do End If 'フォントサイズを縮小 With myRange.Font .Size = .Size - 0.5 End With '末尾の文字の行番号を取得 LineEnd = myRange.Characters.Last.Information(wdFirstCharacterLineNumber) End If Loop DoEvents End If End Sub
コメント
お世話になります。いつも大変勉強させていただいております。
こちらのマクロについて質問なのですが、テキストボックス上の段落についても対象にすることは難しいでしょうか。
えんさん
コメントをどうもありがとうございます!
テキストボックスの場合、別の処理が必要になります。
厳密に処理をすると、「ヘッダーに書かれたグループ化されたテキストボックス1つ1つに対しても処理をする」みたいな感じになり、文書全体のどこかにあるテキストボックスを見つけて処理をする方法もありますが、そこまで細かくしないやり方(当然、処理の漏れがある)もあります。
今後、他の方からのニーズがあるようでしたらブログ記事にします。技術的にできますが、今は記事にする時間がとれないので気長にお待ちください。
新田様
ご返信ありがとうございます。
毎年、レイアウトの変わる名札のようなものを差し込み印刷で作っており、
差し込み位置の細かな調整のために、基本的にすべて文字データの挿入はテキストボックスを使用しています。(40,50のオブジェクトがあります……笑)
もしいつか記事が掲載される日を楽しみにしております。
引き続きよろしくお願い致します。
えんさん
なるほど。配置調整のためにテキストボックスを使われているのですね。
そういう使い方もあるのですね。ヒントをありがとうございます。