はじめに
2008年くらいにWindows版Excelで作成したVBAマクロを見つけたので、Mac版Excelでも動くのか試してみたのですが、大抵動く、という結果でした。
せっかくなので、VBAマクロを切り出して残しておこうと思います。
VBAマクロ
概要
以下のようなデータと範囲選択で Cell2Textbox() を実行すると、、、
セルの入力値でテキストボックスを作成します。テキストボックスの位置関係は、各セルの位置関係に準拠します。
作成後は選択状態のままとなるため、オブジェクトの書式設定を行ったり、あるいはそのまま切り取って別のOfficeアプリケーションに貼り付けたりできるかと思います。
例）PowerPointに貼り付けると以下のようなイメージ（Mac版Officeを使用）
ソース
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 の記述でエラーが出たため、取り急ぎコメントアウトしました。
それ以外は問題ないようです。