今日を乗り切るExcel研究所

Excel に働かされていませんか

Excel 図形のテキストにセルの値をコピーしたい

セルの値を図形のテキストに設定する手順とそれを自動化するマクロを検討します。

f:id:shego:20170529110814p:plain

図形の編集で消耗していませんか

Excel でフローチャートや ER 図を作成するなんてどうかしています。

図形がたくさんあると、位置が微妙にずれたり、書式が違ったり、線が動いたり、コネクタが外れたりと、もうやってられません。

そして特に、図形1個1個にテキスト入力する作業というのがまた、非常に操作がやり辛くてイライラがつのるものです。

Excel 的にはせめて、セルのデータを簡単に活用して図形に設定できる方法があってしかるべきです。

手作業でセルの内容を図形にコピー&ペーストするには

ここでは、シート上のセルの内容をコピーし図形のテキストに貼り付ける簡単な手順がないか探ります。

セルを図形にコピーしてみる

まず、セルをコピーしてそのまま図形に「貼り付け」てみます。

するとなぜかセル自体が「図として貼り付け」られます。

意味が分かりません。

f:id:shego:20170512135450p:plain

テキストを図形にコピーしてみる

そこで、セルの中身のテキストだけをコピーして、選択した図形に「貼り付け」てみます。

すると今度は、別のテキストボックスとして追加されます。

嫌がらせとしか思えません。

f:id:shego:20170512135457p:plain

図形をテキスト編集モードにしてみる

結局、テキストを挿入するには、図形を「テキストの編集」モードにするしかないようです。

そこで、図形を選択してからF2キーを押してみます。

なぜか図形ではなく数式バーの方にカーソルが入ります。

なぜかそこにテキストは入力できません。

許し難いことです。

f:id:shego:20170513154317p:plain

図形をテキスト編集モードにするには、右クリックで「テキストを編集」選択します。

するとカーソルが入って、テキストを貼り付けれられるようになります。

また素のテキストではなく、コピーしたセルを「貼り付け」ることもできます。そのとき「貼り付けのオプション」メニューが表示されて3つの形式が提示されます。

f:id:shego:20170512135508p:plain

このメニューもわかりにくいのですが、たとえば、デフォルトの書式(テーマの書式)が気に入らなくて、図形の文字の色やサイズを自分で変更設定していた場合、左から以下のような挙動になります。

  • 「貼り付け先のテーマを使用(H)」
    ⇒ 設定した書式が無視され、テーマの書式に戻されます
  • 「元の書式を保持(K)」
    ⇒ 設定した書式が無視され、コピーしたセルの書式が適用されます
  • 「テキストのみ保持(T)」
    ⇒ 設定した書式が適用されます

図形にセルへの参照を設定してみる

「貼り付け」ではありませんが、図形のテキストにセルへの参照を設定することもできます。

図形を選択して数式バーにセルへの参照式を入力(= のあとにセルをクリック)すると、その値がテキストとして表示され、セル内容の変更も動的に反映されます。

ただし、書式の形式は選択できず、図形のテキスト書式がセルのテキスト書式で上書きされていまします。

f:id:shego:20170512135514p:plain

結局

やりたいのは、図形がテキスト編集モードになっていて、カーソルだけが入っている状態にすることです。

基本的に、図形をテキスト編集モードにするには、図形の右クリックメニューで「テキストの編集」を選びます。

図形に既にテキストがあれば、右クリックしなくても、キーを叩いて文字入力を始めることができます。

また、テキストがなくても、書式を変更(太字など)をすることで、カーソルを入れることはできます。

もちろんそれは、選択した図形が対象ですが、その図形選択自体が、マウスなしではできないようなのです。

以下、コピーしたセルの内容を図形のテキストに貼り付ける手順例を示します。

【手順例】

  1. テキストと取りたいセルをコピーします(Ctrl + C
    • 複数セル可
  2. 対象の図形を編集状態にします
    • テキストのない新規の図形の場合
      1. マウスで図形を選択します
      2. キー操作: Ctrl + BCtrl + B
        Ctrlを押しながらBを2回連打します
        「太字」はキャンセルされ、カーソルだけが残ります
    • 既にテキストのある図形の場合
      1. 図形のテキスト部分マウスクリック
        地の部分ではダメです
      2. Ctrl + Aで図形テキストを全選択
  3. セルの内容を貼り付けます
    • キー操作(テーマの書式で貼り付け): Ctrl + V ⇒ ESC
    • キー操作(セルの書式もそのまま貼り付け): Ctrl + VCtrlKESC
    • キー操作(図形の書式で貼り付け): Ctrl + VCtrlTESC
      「貼り付けのオプション」はESCキーで抜けます。間違えてEnterを打つと2回貼り付けられてしまいます。

図形を選択することがキー操作だけでは出来きないので、どうしてもマウスとの二刀流になります。

 


セルの値を図形に設定するマクロ

セルの値を図形のテキストに設定するマクロを作成してみました。

下記マクロ VBA は、複数の図形に選択セルの値を順次挿入します。

テキストの書式は、図形の方の書式を使います。線(コネクタ)やグループ化された図形はスキップします。

選択セルより図形の方が足りないと、最後の図形を複製します。たとえば、図形を一つだけ用意しておくことで、セルの数だけ差し込み生成することができます。(グループ化された図形内の差し込みはまた別の課題とします)

単純に「セルの値」を設定するものだけでなく、「セルの参照」を設定するマクロも用意しました。

Option Explicit

Sub 図形のテキスト挿入_セルの値()
    'On Error GoTo No_shape_selected
    copyCellToShape ActiveWindow.RangeSelection, Selection.ShapeRange, "setShapeText"
    ActiveWindow.RangeSelection.Select
    Exit Sub
No_shape_selected:
    Beep ' テキスト図形なし
End Sub

Sub 図形のテキスト挿入_セルの参照()
    'On Error GoTo No_shape_selected
    copyCellToShape ActiveWindow.RangeSelection, Selection.ShapeRange, "setShapeFormula"
    ActiveWindow.RangeSelection.Select
    Exit Sub
No_shape_selected:
    Beep ' テキスト図形なし
End Sub

Private Sub copyCellToShape(srcCells As Range, dstShapes As ShapeRange, proc As String)
    Dim textShapes As ShapeRange
    Set textShapes = collectTextShapes(dstShapes, srcCells.Count)
    If textShapes Is Nothing Then
        Err.Raise Number:=vbObjectError + 1024, Description:="テキスト図形なし"
    End If
    
    Dim i As Integer: i = 1
    Dim c As Range
    For Each c In srcCells
        Run proc, textShapes(i), c
        i = i + 1
    Next
End Sub

Private Function collectTextShapes(orgShapes As Object, size As Integer) As ShapeRange
    Dim tail As Shape
    Dim cnt As Integer
    cnt = 0
    Dim shpNames As String
    shpNames = ""
    
    Dim shp As Shape
    For Each shp In orgShapes
        If shp.Type = msoAutoShape Or shp.Type = msoTextBox Then
            If shp.AutoShapeType <> msoShapeMixed Then
                shpNames = shpNames & vbTab & shp.Name
                Set tail = shp
                cnt = cnt + 1
            End If
        End If
    Next
    If cnt = 0 Then
        Set collectTextShapes = Nothing
        Exit Function
    End If
    
    For cnt = cnt + 1 To size
        Set tail = tail.Duplicate
        shpNames = shpNames & vbTab & tail.Name
    Next
    
    Set collectTextShapes = orgShapes.Parent.Shapes _
        .Range(Split(Mid(shpNames, 2), vbTab))
End Function

Private Sub setShapeText(shp As Shape, aCell As Range)
    shp.DrawingObject.Formula = ""
    shp.TextFrame2.TextRange.Characters.Text = aCell.Text
End Sub

Private Sub setShapeFormula(shp As Shape, aCell As Range)
    Dim sheetName As String
    sheetName = "'" & Replace(aCell.Worksheet.Name, "'", "''") & "'"
    shp.TextFrame2.TextRange.Characters.Text = ""
    shp.PickUp
    shp.DrawingObject.Formula = "=" & sheetName & "!" & aCell.Address
    shp.Apply
End Sub

【使い方】

  1. 上記VBAプログラムを標準モジュールにコピー&ペーストします
  2. 元データのセルを選択します
    • 複数選択可
  3. 挿入先の図形を選択します
    • 複数選択可
      • 図形を選択した順番に、セルの値が設定されます
    • 図形を選択すると、セルの選択が解除された状態になりますが、そのままでOKです
  4. マクロを実行します
    • セルの値をコピーするには「図形のテキスト挿入_セルの値」マクロを実行します
    • セルの参照を設定するには「図形のテキスト挿入_セルの参照」マクロを実行します
  5. 図形のテキストにセルの内容が表示されます

【注意】 本マクロの結果は「元に戻す」(Undo) できませんのでご注意ください

まとめ

図形テキストにセルの値をデータとして一括で差し込める方法がないか調査したのですが、Excel にそのような機能はありませんでした。

手作業でよる手順を検討しましたが、まだまだ複雑で、大した効率化にはなりそうもありません。

それを自動化するマクロも作成しましたが、それが「便利か」は、実際の作図の工程にうまくマッチするかどうかによって異なるでしょう。

結局のところ、Excel は本来、表計算ソフトであり作図ツールではないので、本当に効率化を求めるなら、専用アプリの利用を検討したほうがいいでしょう。

本記事の内容は Window 10 の Excek 2013 で動作確認しました。