シーゴの Excel 研究室

タイトル変更しました (旧称:今日を乗り切るExcel研究所)

Excel 図形のテキストをセル上で一気に修正したい

今回は、複数図形のテキストを編集するため、図形テキストのセル参照が利用できないか検証します。

また、図形テキストをセル参照として書き出すマクロを作成します。

Excel 図表を修正するのはたいへん

フロー図や構成図、操作手順、座席表など、Excel 文書に図形や画像をを使って図表を作成することがよくあります。

最初は楽しくても、ハコや線が増えるにつけどんどんやり辛くなりなります。

それでも作りっぱなしならまだいいのですが、修正やメンテナンスで何かをちょっとでも変更するとなると、図形の位置合わせ、コネクタの修繕、線種や色の区別、フォントの変更、レイアウトの移動、グループの組直し、テキストの編集などが必要になり、手が焼けます。

中でも特にテキストボックスやハコの「図形テキストの編集」は厄介です。

1個でも面倒なのに、固有名詞や統一表現の変更が入るともう大変です。

Excel の検索・置換機能は、図形のテキストまで対象にしてくれないので、 人間の目でブック全体の図形を全てチェックし、一つ一つ手作業で編集する必要があります。

もっと最悪なのは、図形テキストが連番になっていて、番号をずらさなければならなくなった時です。 (筆者は最近これをやるハメになって泣きました)

たくさんある図形のテキストを一気に修正する方法はないのでしょうか。

図形テキストを一気に修正するには

Excelやネットなどでいろいろ調べてみても、Excel の機能にはテキスト置換のような、一気に図形テキストを修正する方法は無く、どう工夫のしようもないようです。

結局、アドインマクロに頼らざるを得ないという状況のようです。

ネットで検索すれば、図形でもテキスト置換が一発でできる優れたアドインや便利なマクロがすぐに見つかります。

この記事ではあえて紹介はしませんが、お急ぎの方は、まずはそちらの方をお試しください。

個人的に、それらのツールは確かに便利だとは思うのですが、今回筆者がやりたい、テキスト全体を見直すような編集作業をするには、使い勝手がちょっと違うように感じます。

まして連番問題までは解決してくれません。

図形テキストのセル参照を使ってみる

テキストを編集するのなら、図形よりもセルの方がずっと楽です。

テキストボックスやオートシェープの図形などテキスト表示可能なハコには、セルへの参照設定をする機能があります。

図形を選択後、数式バーでセルのアドレス(「=$A$1」のような)を入力すると、以降、参照先のセルの内容が図形テキストとして表示されるようになります。

セルの内容は動的に反映されます。
つまり、セル側の文言を編集すると、図形側のテキストも自動的に更新されるのです。

セル側でテキスト編集できれば、少しは修正が楽になりそうな気がします。
やってみましょう。

  f:id:shego:20190505112543g:plain  

【手順例】

  1. 図形テキストに表示したい文言をセルに入力しておきます
  2. 対象の図形を選択し後、数式バーを入力状態にします
    • キー操作: F2
  3. 数式バーに参照先セルへの参照アドレスを入力します
    • = を入力後、文言セルをクリックするか、=$A$1 のように直接入力します
  4. Enter を押します
  5. 参照先のセル文言が図形テキストに反映されます
  6. 必要ならセルの文言を編集します
    • 図形テキストにも修正文言が自動で反映されます
  7. セル参照が不要になったら、図形を選択し、数式バーをクリアします
    • キー操作: F2Shift+HomeDeleteEnter

図形上ではテキスト編集不可の状態になるので注意が必要です。
数式バーでセル参照を削除すれば編集可に戻ります。

途中で図形テキストのフォントが黒文字に変わってしまうのが何なのか、気になりますね。

実はこれ、セルのフォントもそのまま図形に反映されているからなのです。
(自動反映されるのは最初だけです。セルのフォントを変更した場合には、手動で数式バーを更新しないと反映されません)

しかも、セル参照を削除すると、もとの図形の「スタイルのフォント」に戻されてしまいます。 図形のフォントをカスタマイズしていた場合、困ったことになるでしょう。

さて、最初からセル参照で図形テキストを作成するならこの方法でもいいかもしれませんが、今回やりたいのは既存の図形テキストの編集です。

そのためには、図形テキストから文言をセルに「書き出す(コピーする)」必要があります。
複数図形でこれを繰り返すのは、マウスで図形とセルを行ったりで、とてもやってられません。

マウス操作を減らす工夫には、テキストエディタを介した方法があります。
これで少しは効率化できるかもしれません。

f:id:shego:20190515024747g:plain

【手順例】

  1. テキストエディタも開いておきます
  2. 図形のフォントをカスタマイズしている場合、見本としてコピーを取っておきます
    • 本手順によって、図形テキストのフォントがデフォルト(白)になってしまうため、復旧に必要です
    • Excel が用意した「図形のスタイル」を適用している場合は問題ありません
  3. Excel で図形を選択し、以下の作業を繰り返します
    1. 図形テキストをコピーします
      • キー操作: EnterCtrl+C
    2. テキストエディタに貼り付けします
      • キー操作:
        1. Alt+TABでテキストエディタに切り替え
        2. Ctrl+Vでテキストエディタに貼り付け
        3. Alt+TABでExcelに戻る
    3. 次の図形を選択し、コピー&ペーストを繰り返します
      • キー操作:
        1. Esc で図形テキストの編集モードを抜け、図形選択状態に戻します。
        2. TAB(次へ) か Shift+TAB(前へ)で次の図形を選択します
  4. 終わったらエディタからセルにテキストをコピー&ペーストします
  5. 各セルの参照用の数式を取得します
    1. 隣のセルに参照数式を入力し、Ctrl+Shift+@を押します
    2. 数式が展開されるので、セル参照の数式をコピーします
    3. 再びCtrl+Shift+@で通常モードに戻します
  6. セル参照の数式をテキストエディタにコピー&ペーストします
  7. 再度Excel で図形を選択し、以下の作業を繰り返します
    1. 図形の数式バーを入力状態にします
      • キー操作: F2
    2. テキストエディタからセル参照を数式バーに貼り付けします
      • キー操作:
        1. Alt+TABでテキストエディタに切り替え
        2. Ctrl+Cでテキストエディタからコピー
        3. Alt+TABで Excel に戻る
        4. Ctrl+Vで数式に貼り付け
        5. Enterで数式に貼り付け
    3. 次の図形を選択します
      • キー操作:
        1. Enter (かTAB)で図形の数式入力モードを抜け、図形選択状態に戻します。
        2. TAB(次へ) か Shift+TAB(前へ)で次の図形を選択します
  8. テキスト内容を修正します
    • 置換などExcel の機能が使えます
  9. 修正が完了したら再度Excel で図形を選択し、セル参照の削除を繰り返します
    1. 図形の数式バーを入力状態にします
      • キー操作: F2
    2. 図形の数式バーをクリアします
      • キー操作: Ctrl+HomeDel
    3. 次の図形を選択します
      • キー操作:
        1. Enter (かTAB)で図形の数式入力モードを抜け、図形選択状態に戻します。
        2. TAB(次へ) か Shift+TAB(前へ)で次の図形を選択します
  10. 必要なら見本図形から書式のみコピー・貼り付けしてフォントを復旧します 1 . 見本図形を選択します
    1. 「ホーム」タブ⇒「クリップボード」にある「書式のコピー/貼り付け」の刷毛アイコンをダブルクリックします
    2. マウスカーソルが刷毛になっている状態(書式の貼り付けモード)でフォントを戻したい図形をクリックしていきます
    3. 終了したら Esc キーを押して通常モードに戻します

テキスト内容を修正には、 Excel の機能(コピー&ペースト、置換、並べ替え、連続データ、フラッシュフィルなど)が使えます。

セル間でテキストを入れ替えるにはコピー&ペースト(Ctrl+C)を使ってください。
カット&ペースト(Ctrl+X「切り取り」)を使うと、図形のセル参照がリンク切れなってしまいます。

どうでしょうか。

操作を練習して慣れれば、使いものになりそうでしょうか。

セルで編集できるのは確かに理想的ですが、そのための書き出し作業がそれを超える労力です。

図形数個程度なら、普通に図形テキストを編集したほうが早そうです。 逆にシート全体やブック全体となったら手作業ではもう無理ですね。

こういう単純作業はマクロで自動化するに限ります。

 



 

ちなみにですが、ハコ型図形だけでなく、グラフ内のタイトルや軸ラベルもセル参照化できることは知っておいた方がいいでしょう。 ひな形の定型グラフにグラフタイトルや軸ラベルを差し込むといった使い方ができそうです。

f:id:shego:20190507003004g:plain

 

図形テキストのセル参照を設定をするマクロ

テキストボックスやオートシェープのテキストを書き出し、セル参照を設定するマクロを作成しました。

図形テキストのセル参照設定_選択図形」マクロは、選択した図形のテキストを指定のセルに書き出し、そのセルへの参照を図形に設定します。
図形の複数選択による一括設定も可能です。
テキストを持たない空白図形の場合、図形の識別名(「Rectangle 1」など)を代わりに設定します。

図形テキストのセル参照設定_シート図形」マクロは、シート上にあるすべての図形テキストを、メンテナンス作業用の新規シートに書き出し、そのセルへの参照を各図形に設定します。
空白図形は無視します。
また、複数シートにも対応します。シートを複数選択状態にして本マクロを実行してください。
作業用シートでは対象図形のプレビューも表示しますので確認しながらの編集作業が可能です。

図形テキストのセル参照解除」マクロを実行すると、シート上の全ての図形のセル参照が一括解除されます。
複数シート選択にも対応します。

フォントは図形テキストのフォントがカスタマイズされていても保持されます。

VBA プログラムが長くなるので2つに分けます。 両方に「図形テキストのセル参照解除」マクロも同じものが入っています。

  1. 「図形テキストのセル参照設定_選択図形」マクロ
  2. 「図形テキストのセル参照設定_シート図形」マクロ

1. 「図形テキストのセル参照設定_選択図形」マクロ

Option Explicit

Sub 図形テキストのセル参照設定_選択図形()
    If Not hasShapeRange(Selection) Then Beep: Exit Sub
    Dim curWorkbook As Workbook
    Set curWorkbook = ActiveWorkbook
    
    Dim refs As Range
    Set refs = inputRange("図形テキストの参照先セルを指定してください", "参照先セルの指定", [A1])
    If refs Is Nothing Then Exit Sub
       
    If Not refs.Worksheet.Parent Is curWorkbook Then _
        MsgBox "他ブックヘの参照は指定できません。": Exit Sub
     
    Dim shp As Shape
    Dim refCell As Range
    Dim i As Long
    i = 1
    For Each shp In flattenShapeTree(Selection.ShapeRange)
        If isBoxy(shp) Then
            Set refCell = getCellAt(refs, i)
            refCell.Value = IIf(Trim(getShapeText(shp)) <> "", getShapeText(shp), shp.Name)
            Call setShapeTextRef(shp, refCell)
            i = i + 1
        End If
    Next
End Sub

Sub 図形テキストのセル参照解除()
    Dim sht As Object
    Dim shp As Shape
    For Each sht In ActiveWindow.SelectedSheets
        For Each shp In flattenShapeTree(sht.Shapes)
            If isBoxy(shp) Then Call unsetShapeTextRef(shp)
        Next
    Next
End Sub

Private Function getShapeText(shp As Shape) As String
    getShapeText = shp.DrawingObject.Text
End Function

Private Sub setShapeTextRef(shp As Shape, ref As Range)
    shp.PickUp
    shp.DrawingObject.Formula = "=" & getSheetRangeAddr(ref)
    shp.Apply
End Sub

Private Sub unsetShapeTextRef(shp As Shape)
    If shp.DrawingObject.Formula <> "" Then shp.DrawingObject.Formula = ""
End Sub

Private Function isBoxy(shp As Shape) As Boolean
    Select Case shp.Type
    Case msoAutoShape
        isBoxy = shp.AutoShapeType <> msoShapeMixed
    Case msoTextBox, msoCallout
        isBoxy = True
    Case Else
        isBoxy = False
    End Select
End Function

Private Function getSheetRangeAddr(rng As Range) As String
    getSheetRangeAddr = "'" & Replace(Replace(rng.Worksheet.Name, "'", "''"), "’", "’’") & "'!" & rng.Address
End Function

Private Function inputRange(prompt As String, title As String, rngDefault As Range) As Range
    Set inputRange = CRange(Application.InputBox(prompt, title, rngDefault.Address, Type:=8))
End Function

Private Function CRange(val As Variant) As Range
    Set CRange = IIf(TypeName(val) = "Range", val, Nothing)
End Function

Private Function flattenShapeTree(ByVal shps As Object) As Collection
    Set flattenShapeTree = New Collection
    Dim shp As Shape, subShp As Shape
    For Each shp In shps
        If shp.Type = msoGroup Then
            For Each subShp In flattenShapeTree(shp.GroupItems)
                flattenShapeTree.Add subShp
            Next
        Else
            flattenShapeTree.Add shp
        End If
    Next
End Function

Private Function getCellAt(rng As Range, pos As Long) As Range
    Dim c As Range
    Dim i As Long
    i = 1
    For Each c In rng
        If i = pos Or i >= rng.CountLarge Then
            Set getCellAt = c.Offset(pos - i)
            Exit Function
        End If
        i = i + 1
    Next
End Function

Private Function hasShapeRange(ByVal obj As Object) As Boolean
    On Error Resume Next
    hasShapeRange = Not obj.ShapeRange Is Nothing
    Err.Clear
End Function

【使い方】図形テキストのセル参照設定_選択図形

  1. Excel VBE で標準モジュールを新規作成し、上記 VBA プログラムをコピー&ペーストします
    • 2つ目のマクロVBA(シート図形)とは別のシートで貼り付けしてください
  2. セル参照化したい図形を選択します
    • テキストボックスやハコ型のオートシェープ、吹き出しなど(線以外の矩形や吹き出しなど)を選択してください
    • 複数図形を選択可能です
    • テキストのない図形でも選択可能です
    • グループが選択された場合、その中の全ての子図形が対象となります
  3. 「図形テキストのセル参照設定_選択図形」マクロを実行します
  4. セル選択のダイアログが開くので、参照先のセル範囲を指定します
    • 図形の選択順で出力されます
    • 連続しないセル範囲を複数指定することも可能です(Ctrlを押しながらクリック)
    • 別シートのセル範囲を選択することも可能です。(他ブック参照は不可です)
  5. 「OK」ボタンを押します
  6. 指定のセル範囲へ図形テキストが書き出されます
    • 図形から参照されています
  7. 書き出されたテキストを編集すると図形に反映されます
    • 「置換」による変更も反映されます

【使い方】図形テキストのセル参照解除

  1. セル参照した図形のあるシートを開きます
    • 複数シート選択も可能です
  2. 「図形テキストのセル参照解除」マクロを実行します
  3. シート上の全ての図形のセル参照が解除されます
    • 図形個別指定による解除はできません

【注意】 書き出し先のセルに既存データがあったとしても上書きされて元に戻す(Undo)することもできません。必ず Excel ファイルのバックアップを取ってからお試しください。

 



 

2. 「図形テキストのセル参照設定_シート図形」マクロ

Option Explicit

Sub 図形テキストのセル参照設定_シート図形()
    Const SHOW_PREVIEW = True
    On Error GoTo failed
    
    Dim selShts As Sheets
    Set selShts = ActiveWindow.SelectedSheets
    selShts(1).Select
    ActiveWorkbook.Worksheets.Add Before:=selShts(1)
    
    Dim sht As Object
    Dim curShape As Shape
    Dim curRow As Range
    Dim shapesArea As Range
    Dim previewArea As Range
    For Each sht In selShts
        Set curRow = ActiveWindow.VisibleRange.Range("A1")
        Call setSheetLink(curRow, sht)
        Set curRow = curRow.Offset(1).Resize(1, 2)
        Set shapesArea = Nothing
        
        For Each curShape In flattenShapeTree(sht.Shapes)
            If isBoxy(curShape) Then
                If getShapeText(curShape) <> "" And curShape.Visible Then
                    curRow.Value = Array(curShape.Name, getShapeText(curShape))
                    Call setShapeTextRef(curShape, curRow(2))

                    Set curRow = curRow.Offset(1)
                    Set shapesArea = mergeRanges(shapesArea, curShape.TopLeftCell, curShape.BottomRightCell)
                End If
            End If
        Next
        
        If SHOW_PREVIEW And Not shapesArea Is Nothing Then
            Set previewArea = ActiveWindow.VisibleRange
            Set previewArea = Intersect(previewArea, previewArea.Offset(3, 5)).Offset(-2, -1)
            Call previewShapesArea(shapesArea, previewArea)
        End If
        
        Do
            ActiveWindow.LargeScroll Down:=1
        Loop Until IsEmpty(ActiveWindow.VisibleRange(1))
    Next
    Application.Goto ActiveSheet.Range("A1"), Scroll:=True

failed:
    If Err.Number <> 0 Then MsgBox Err.Description, vbCritical
End Sub

Sub 図形テキストのセル参照解除()
    Dim sht As Object
    Dim shp As Shape
    For Each sht In ActiveWindow.SelectedSheets
        For Each shp In flattenShapeTree(sht.Shapes)
            If isBoxy(shp) Then Call unsetShapeTextRef(shp)
        Next
    Next
End Sub

Private Function getShapeText(shp As Shape) As String
    getShapeText = shp.DrawingObject.Text
End Function

Private Sub setShapeTextRef(shp As Shape, ref As Range)
    shp.PickUp
    shp.DrawingObject.Formula = "=" & getSheetRangeAddr(ref)
    shp.Apply
End Sub

Private Sub unsetShapeTextRef(shp As Shape)
    If shp.DrawingObject.Formula <> "" Then shp.DrawingObject.Formula = ""
End Sub

Private Sub previewShapesArea(ByVal src As Range, ByVal dst As Range)
    src.Copy
    DoEvents
    With dst.Worksheet.Pictures.Paste(True).ShapeRange
        .LockAspectRatio = msoTrue
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        .Width = IIf(.Width < dst.Width, .Width, dst.Width)
        .Height = IIf(.Height < dst.Height, .Height, dst.Height)
        .Top = dst.Top: .Left = dst.Left
        .LockAspectRatio = msoFalse
        .PictureFormat.CropTop = -12: .PictureFormat.CropLeft = -12
        .PictureFormat.CropBottom = -12: .PictureFormat.CropRight = -12
    End With
    Application.CutCopyMode = False
    DoEvents
End Sub

Private Function isBoxy(shp As Shape) As Boolean
    Select Case shp.Type
    Case msoAutoShape
        isBoxy = shp.AutoShapeType <> msoShapeMixed
    Case msoTextBox, msoCallout
        isBoxy = True
    Case Else
        isBoxy = False
    End Select
End Function

Private Function flattenShapeTree(ByVal shps As Object) As Collection
    Set flattenShapeTree = New Collection
    Dim shp As Shape, subShp As Shape
    For Each shp In shps
        If shp.Type = msoGroup Then
            For Each subShp In flattenShapeTree(shp.GroupItems)
                flattenShapeTree.Add subShp
            Next
        Else
            flattenShapeTree.Add shp
        End If
    Next
End Function

Private Function mergeRanges(ParamArray rngs()) As Range
    Dim rng As Variant
    For Each rng In rngs
        If mergeRanges Is Nothing Then
            Set mergeRanges = rng
        ElseIf Not rng Is Nothing Then
            Set mergeRanges = Range(mergeRanges, rng)
        End If
    Next
End Function

Private Sub setSheetLink(ByVal anch As Range, sht As Worksheet)
    anch.Value = sht.Name
    anch.Hyperlinks.Add anch, "", getSheetRangeAddr(sht.Range("A1")), sht.Name
End Sub

Private Function getSheetRangeAddr(rng As Range) As String
    getSheetRangeAddr = "'" & Replace(Replace(rng.Worksheet.Name, "'", "''"), "’", "’’") & "'!" & rng.Address
End Function

【使い方】図形テキストのセル参照設定_シート図形

  1. Excel VBE で標準モジュールを新規作成し、上記VBAプログラムをコピー&ペーストします
    • 1つ目のマクロVBA(図形選択)とは別のシートで貼り付けしてください
  2. 図表のあるシートを開きます
    • 複数シート選択も可能です
  3. 「図形テキストのセル参照設定_シート図形」マクロを実行します
  4. 作業用の新規シートが追加され、図形テキストが書き出されます
    • 各シートの図形から参照されています
    • 作業効率化のため、図形の識別名と図全体のプレビューも表示されます
    • 空白図形は無視されます
  5. 書き出されたテキストを編集すると図形に反映されます
    • プレビューでも確認できます

 

  • 作業用シートを削除する前に「図形テキストのセル参照解除」マクロを実行するようにしてください。
    セル参照されたまま作業用シートを削除すると、図形のテキストはそのままですが、セル参照はリンク切れなり、編集もできない状態になります。
    ただ、その状態でも「図形テキストのセル参照解除」マクロを実行すればセル参照は正常に削除されます。

  • 複数シートを選択状態にすると、各シートの図形テキストを全て作業用シートに書き出します
    シートごとに画面区切りで配置しますので、縦スクロール(PageDown/PageUp)で移動してください。

  • シート名をクリックするとでそのシートに移動できます。
    作業用シートに戻るには「Ctrl+GEnter」が使えます。

  • プレビューは「リンクされた図」として貼り付けされています。
    つまり、参照セルの修正内容はプレビューにも自動的に反映されます。

【使い方】図形テキストのセル参照解除

  1. セル参照した図形のあるシートを開きます
    • 複数シート選択も可能です
  2. 「図形テキストのセル参照解除」マクロを実行します
  3. シート上の全ての図形のセル参照が解除されます
    • 図形個別指定による解除はできません

【注意】 選択シートの図形が多くなると処理に時間がかかるようです。あまりたくさんのシートを選択しないようにしてください。

【制限事項】

  • グラフや SmartArt には対応しません
  • セルのフォント設定は図形に反映されず、図形のフォントのままで表示されます
  • 図形テキストの中の一部分にだけに設定したフォントスタイル(強調など)は失われます
  • シート名に全角シングルクオート(’)を含むシート図形のプレビューは作成できません。

【免責】 本マクロの使用によって発生したいかなる損害や損失にも当ブログは積金を負いかねますのであらかじめご承知おきください。

まとめ

Excel 機能で手軽に複数図形のテキストを編集する方法はありません。

テキストボックスやオートシェイプのセル参照機能はあまり知られていませんが、うまく使えば図形の文言を管理・修正するのに役立ちます。

図表の作り初めから、セル参照で運用するものと決めてかかれば、そう負担増にもならず、後からのテキスト変更にも強くなるでしょう。
たとえば「座席表」などは、社員名がセル参照になっていれば席替えも楽にできます。

そのような用途には、以前のブロク記事で紹介した「セルのテキストから図形を作成するマクロ」も役に立つかもしれません。

www.shegolab.jp

一方、ブック全体の図表など、たくさんある既存の図形のテキストを一気に修正するのにも活用したいところですが、その用途には、テキストの書き出しのコストが高くて実用的ではありません。

今回はマクロを使って図形テキストの書き出しとセル参照設定を自動化し、手間を軽減してみました。

余談ですが、図形とシートデータの連携がテキストのセル参照しかないのは、とても残念な感じでした。
「データの見える化」が重要視され、データ分析などでも複雑なデータの斬新な表現力が要請される昨今、図形は Excel の機能としてもっと積極的に活用できてもいいんじゃないかな、と Excel 研究員的には思ったのですが、どうでしょうかねエクセルさん。

本記事の内容は Windows 10 と Excel 2013 で検証しました。

関連記事

www.shegolab.jp