Excelで作成されたマニュアルをWord化したい場合がある。
一旦PDFにしてから読み込んでくる手もあるが、あとで色々と機能を付け足すためにもマクロでやってみたいと思う。
Excelマニュアルは、以下のように文字と画像が交互に配置されているものを想定している。
このまま交互にWordに張り付ければ良いと考えるかもしれないが、文字はセルに書かれているのに対し、画像はセルとは関係なく浮かんでいるので、見た目ほど簡単ではない。
例えば文字だけ取り出すのは以下のように全セルを走査すれば簡単にできる。
Sub StringPicker() For Each r In Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)) If r.Value <> "" Then Debug.Print r.Value Next End Sub
また、画像だけ取り出すのも以下のように全シェイプを走査すれば良い。
Sub PicturePicker() Dim s As Shape For Each s In ActiveSheet.Shapes Debug.Print s.Name Next End Sub
では、交互に並んだ順を崩さずにWordに張り付けるにはどうするか。
まず、文字と画像を段落要素として共通に扱えるようにクラスを作成する。
クラス名はParagraphItemとした。
Private InnerItem Private InnerTop As Double Property Get Top() As Double Top = InnerTop End Property Property Get Self() As ParagraphItem Set Self = Me End Property Property Get PrintableItem() As String If TypeName(Item) = "String" Then PrintableItem = Item Else PrintableItem = Item.Name End If End Property Property Set Item(obj As Object) InnerTop = obj.Top If TypeName(obj) = "Range" Then Let InnerItem = obj.Value ElseIf TypeName(obj) = "Shape" Then Set InnerItem = obj Else Err.Raise 1000, , "ParagraphItemはRangeとShapeのみ格納できます。" End If End Property Property Get Item() As Variant If IsObject(InnerItem) Then Set Item = InnerItem Else Let Item = InnerItem End If End Property
これを使うサンプルコードはこちら。
ItemにRangeかShapeを格納し、共通のプロパティPrintableItemでデバッグプリントしている。
Sub ParagraphPicker() Dim C As New Collection '文字列のピックアップ For Each r In Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)) If r.Value <> "" Then With New ParagraphItem Set .Item = r C.Add .Self End With End If Next '画像のピックアップ Dim s As Shape For Each s In ActiveSheet.Shapes With New ParagraphItem Set .Item = s C.Add .Self End With Next '出力 Dim p As ParagraphItem For Each p In C Debug.Print p.PrintableItem Next End Sub
結果は以下のように、文字、画像の順に出力される。
■環境変数の設定方法について Win+Pauseキーでコントロールパネルのシステムを表示させます。 次に、システムの詳細設定をクリックしてください。 次に環境変数ボタンをクリックします。 次に、ユーザー環境変数グループにある、新規ボタンをクリックします。 最後に、変数名と値を入れて、OKで閉じます。 他の画面もOKで閉じてください。 以上で完了です。 Picture 1 Picture 2 Picture 3 Picture 4
ここで前回のコレクションのソートを登場させる。
ソートのコードはこちらの記事を参照。
thom.hateblo.jp
そして、ソートキー関数(前回記事にて説明)は、次のように用意する。
Function SortByVerticalLocation(V As ParagraphItem) As Double SortByVerticalLocation = V.Top End Function
後は出力前に、CSort C, "SortByVerticalLocation"として呼び出すだけだ。
結果は次のように、Topプロパティで並び替えされている。
■環境変数の設定方法について Win+Pauseキーでコントロールパネルのシステムを表示させます。 次に、システムの詳細設定をクリックしてください。 Picture 1 次に環境変数ボタンをクリックします。 Picture 2 次に、ユーザー環境変数グループにある、新規ボタンをクリックします。 Picture 3 最後に、変数名と値を入れて、OKで閉じます。 Picture 4 他の画面もOKで閉じてください。 以上で完了です。
Word張り付けの実装
以下が完成したメインコードである。
実行には、Microsoft Word XX.X Object Libraryの参照設定が必要となる。
Sub ParagraphPicker() Dim C As New Collection '文字列のピックアップ For Each r In Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)) If r.Value <> "" Then With New ParagraphItem Set .Item = r C.Add .Self End With End If Next '画像のピックアップ Dim s As Shape For Each s In ActiveSheet.Shapes With New ParagraphItem Set .Item = s C.Add .Self End With Next CSort C, "SortByVerticalLocation" Dim WD As New Word.Application WD.Visible = True WD.Documents.Add '出力 Dim p As ParagraphItem For Each p In C If IsObject(p.Item) Then p.Item.Copy WD.Selection.Paste Else WD.Selection.TypeText p.Item End If WD.Selection.TypeParagraph Next End Sub
実行するとちゃんとWordに転記される。
画像サイズのせいで余白が大きくなっているが、これは後から調整するか、張り付けの前にマクロでやっても良い。