Excelの選択範囲の情報でテキストボックスを作成するVBAマクロ


# はじめに
2008年くらいにWindows版Excelで作成したVBAマクロを見つけたので、Mac版Excelでも動くのか試してみたのですが、大抵動く、という結果でした。
せっかくなので、VBAマクロを切り出して残しておこうと思います。

# VBAマクロ
## 概要
以下のようなデータと範囲選択で Cell2Textbox() を実行すると、、、
>![処理実行前イメージ](https://qiita-image-store.s3.amazonaws.com/0/174697/73bc0feb-0d6b-5f69-093d-3b18b6212abb.png "処理実行前イメージ")

セルの入力値でテキストボックスを作成します。テキストボックスの位置関係は、各セルの位置関係に準拠します。
>![処理実行後イメージ](https://qiita-image-store.s3.amazonaws.com/0/174697/c0b58b09-598a-7d6c-6560-190867d00252.png "処理実行後イメージ")

作成後は選択状態のままとなるため、オブジェクトの書式設定を行ったり、あるいはそのまま切り取って別のOfficeアプリケーションに貼り付けたりできるかと思います。

例）PowerPointに貼り付けると以下のようなイメージ（Mac版Officeを使用）
>![PowerPointにC&P](https://qiita-image-store.s3.amazonaws.com/0/174697/781e6885-011f-a087-53c8-815143f6b8ae.png "PowerPointにC&P")


## ソース

```vbnet
Option Explicit

'=====================================================================
'共通
'=====================================================================

'---------------------------------------------------------------------
'選択エリア情報格納用
'---------------------------------------------------------------------
Public Type SelectionInfo
    StartRowIndex As Long   '選択エリアの一番上の行インデックス
    StartColIndex As Long   '選択エリアの一番左の列インデックス
    EndRowIndex As Long     '選択エリアの一番下の行インデックス
    EndColIndex As Long     '選択エリアの一番右の列インデックス
    RowCount As Long        '選択エリア内の行数
    ColCount As Long        '選択エリア内の列数
    CurrentRowIndex As Long '現在の行インデックス
    CurrentColIndex As Long '現在の列インデックス
End Type

'---------------------------------------------------------------------
'選択エリア情報格納処理
'---------------------------------------------------------------------
'シートの内容を加工するのに必要となる「選択エリア」の情報を格納して返します。
Public Function GetSelectionInfo() As SelectionInfo

    Dim selInf As SelectionInfo
    
    With selInf
        .StartRowIndex = Selection.Row
        .StartColIndex = Selection.Column
        .EndRowIndex = Selection.Rows.Count + Selection.Row
        .EndColIndex = Selection.Columns.Count + Selection.Column
        .RowCount = Selection.Rows.Count
        .ColCount = Selection.Columns.Count
        .CurrentRowIndex = ActiveCell.Row
        .CurrentColIndex = ActiveCell.Column
    End With

    GetSelectionInfo = selInf

End Function

'=====================================================================
' セルの値でテキストボックス作成
' -------------------------------------------------------------------
' 選択範囲のセルの入力値を使ってテキストボックスを作成する
'=====================================================================

Public Sub Cell2Textbox()
    Const SIZE_TBOX_HEIGHT = 30     'テキストボックスの高さ
    Const SIZE_TBOX_WIDTH = 80      'テキストボックスの幅

    Dim idx As Long         '処理用インデックス
    Dim colIdx As Long      '列インデックス
    Dim rowIdx As Long      '行インデックス
    Dim TBox() As Variant   'テキストボックス用配列
    Dim selInf As SelectionInfo

    '初期化
    idx = 0

    '選択情報取得
    selInf = GetSelectionInfo()

    'Rowループ
    For rowIdx = 0 To selInf.RowCount - 1
        'Colループ
        For colIdx = 0 To selInf.ColCount - 1
            If Cells(rowIdx + selInf.StartRowIndex, _
                colIdx + selInf.StartColIndex) <> "" Then
                'テキストボックス作成
                Call MakeTextBox(Cells(rowIdx + selInf.StartRowIndex, _
                    colIdx + selInf.StartColIndex), _
                    (SIZE_TBOX_WIDTH + 5) * colIdx + 10, _
                    (SIZE_TBOX_HEIGHT + 5) * rowIdx + 10, _
                    SIZE_TBOX_WIDTH, SIZE_TBOX_HEIGHT)
                    
                '作成したテキストボックスのNameを配列に格納
                ReDim Preserve TBox(idx)
                TBox(idx) = Selection.Name
                idx = idx + 1
            End If
        Next
    Next
    '作成したテキストボックスの選択
    If idx Then ActiveSheet.Shapes.Range(TBox).Select

End Sub

'------------------------------------------
' 内部関数
'------------------------------------------
'テキストボックスの作成
Private Sub MakeTextBox(val As String, posx As Single, posy As Single, _
                                        wid As Single, hei As Single)

    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        posx, posy, wid, hei).Select

    With Selection.Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "標準"
        .Size = 10
        .StrikeThrough = False
        .Superscript = False
        .Subscript = False
'        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = xlHorizontal
        .AutoSize = False
        .AddIndent = False
    End With
    With Selection.ShapeRange.TextFrame
        .MarginLeft = 0#
        .MarginRight = 0#
        .MarginTop = 0#
        .MarginBottom = 0#
    End With
    Selection.Characters.Text = val

End Sub
```

# 補足
## 共通部について
本当は、共通に記述されているPublicな定義は、別のモジュールに定義されていました。Publicのままにしていますが、特別な意味はないので必要に応じてPrivateにして良いです。
## 所感
複数のテキストボックスで図を書くことが多かったため、位置関係を意識しつつテキストボックスを一括作成したくてこのVBAマクロを作成しました。
MakeTextBox()を調整して任意のテキストボックスの書式にする想定です。

このVBAマクロは今でも使えそう。

## Windows版をMacで実行した際の修正点
Font.OuntlineFont の記述でエラーが出たため、取り急ぎコメントアウトしました。
それ以外は問題ないようです。