🔗
Excel の「リンクされた図」を軽くする

2025/09/02に公開
 はじめにExcel で「リンクされた図」を多用して動作が重くなった経験はないでしょうか。Excel は操作のたびに全てのリンクされた図を更新してまわるらしく、リンクされた図が大量にあるとスクロールでさえ長時間待たされることになります。
今回紹介する llp (Lightweight Linked Picture) は、そうした問題を解決するマクロです。 llp を使うと、図の更新のタイミングをフラグで制御できるようになります。普段は画像の更新を止めて負荷を抑え、必要になったら明示的に更新をかけます。こうすることで、大量のリンクされた図をストレスなく扱えるようになります。
なお、 llp は『【Excel】リンクされた図を含むワークブックが重いので図のリンク状態を制御する』 で紹介されているアイデアを普段使いできる形に落としたものです。本稿の核となるアイデアについてわかりやすく解説されていますので、ぜひご一読ください。

 用語定義llp に関する用語を定義します。
リンクされた図

描画内容が選択範囲の変更に追従する図です。範囲コピー後、右クリックから「形式を選択して貼り付け」にマウスを当てると出てくる候補から作成できます。

名前

Excel の「名前」です。式に名前をつけて管理することができます。
LLP

llp で管理される「リンクされた図」を指します。通常のリンクされた図と違い、LLP_LINK フラグで更新タイミングを制御できます。
LLP_LINK

更新制御用のフラグです。これが TRUE の間は LLP が更新されます。

 llp の導入PERSONAL.XLSB に ModLlp モジュールを作成し、次のコードをペーストします。

PERSONAL.XLSB は個人用マクロブックと呼ばれる特殊なブックです。アドオンと同じく Excel を起動すると自動的に読み込まれます。これを使うと、編集対象のブックに依らずにマクロを呼び出すことが可能になります。
ModLlp' =========================================================================================
' llp - Lightweight Linked Picture
'
'   llp insert     : LLP を挿入します。
'   llp update     : LLP の描画を更新します。
'   llp migrate    : 既存のリンクされた図をすべて LLP に置き換えます。
'   llp clean      : 使われなくなった LLP 関連の名前を削除します。
'   llp goto       : LLP の定義一にジャンプします。
'   llp localize   : LLP 参照から外部ブック名を削除します。
' =========================================================================================

Option Explicit
Private Const MSO_PICTURE As Long = 13

Public Sub llp(Optional ByVal cmd As String = "")

    On Error GoTo FINALLY
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    InitLlpUpdateFlag
    Select Case LCase$(cmd)
        Case "insert", "i": InsertLlp
        Case "update", "u": UpdateAll
        Case "migrate", "m": MigrateAll
        Case "clean", "c": CleanOrphanNames
        Case "goto", "g": GotoSelected
        Case "localize", "l": LocalizeBookRefs
    End Select

FINALLY:
    On Error GoTo 0
    SetLlpUpdateFlag False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    If Err.Number <> 0 Then
        Application.StatusBar = "E" & Err.Number & ": " & Err.Description
    End If
End Sub

Private Sub InitLlpUpdateFlag()
    On Error Resume Next
    ActiveWorkbook.Names.Add name:="LLP_LINK", RefersTo:="=FALSE"
End Sub

Private Sub SetLlpUpdateFlag(ByVal state As Boolean)
    ActiveWorkbook.Names("LLP_LINK").RefersTo = "=" & state
End Sub

Function GenId(Optional ByVal length As Long = 21) As String
    Const chars As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    Dim i As Long
    Dim result As String
    Randomize Timer

    GenId = ""
    For i = 1 To length
        GenId = GenId & Mid$(chars, Int(Rnd() * Len(chars)) + 1, 1)
    Next i
End Function

' LLP_LINK フラグが TRUE のときに f と評価される名前を作り、返す。
Private Function NewLlpName(ByVal f As String) As String
    NewLlpName = "LLP_" & GenId()
    ActiveWorkbook.Names.Add name:=NewLlpName, RefersTo:="=IF(LLP_LINK," & f & ","""")"
End Function

Private Sub InsertLlp()
    Dim s As Shape
    Dim f As String

    If Application.CutCopyMode <> xlCopy Then
        Err.Raise 601, "llp insert", "参照範囲をコピーした状態で実行してください。"
    End If

    ' リンクされた図を貼り付ける
    Application.CommandBars.ExecuteMso "PastePictureLink"
    Set s = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

    ' 貼り付けた図から、参照先を表す式を取得する
    f = GetFormulaOrEmpty(s)
    If Len(f) = 0 Then Err.Raise 602, "llp insert", "参照範囲を取得できませんでした。"

    ' 範囲として評価できない式はセットできないので、一度フラグを TRUE にする
    SetLlpUpdateFlag True
    s.DrawingObject.formula = NewLlpName(f)
    SetLlpUpdateFlag False
End Sub

Private Sub UpdateAll()
    SetLlpUpdateFlag True
    Application.Wait Now + TimeSerial(0, 0, 1)
    SetLlpUpdateFlag False
End Sub

Private Sub MigrateAll()
    Dim ws As Worksheet
    Dim s As Shape
    Dim f As String

    SetLlpUpdateFlag True
    For Each ws In ActiveWorkbook.Worksheets
        For Each s In ws.Shapes
            f = GetFormulaOrEmpty(s)
            If Len(f) <> 0 And Not (f Like "LLP_*") Then
                s.DrawingObject.formula = "=" & NewLlpName(f)
            End If
        Next s
    Next ws
    SetLlpUpdateFlag False
    Application.StatusBar = "移行が完了しました。"
End Sub

Private Sub CleanOrphanNames()
    Dim used As Object
    Dim ws As Worksheet
    Dim s As Shape
    Dim nm As name
    Dim llpName As String
    Set used = CreateObject("Scripting.Dictionary")

    ' 使用中の LLP_* を収集
    used.Add "LLP_LINK", True
    For Each ws In ActiveWorkbook.Worksheets
        For Each s In ws.Shapes
            llpName = GetLlpNameOrEmpty(s)
            If Not used.Exists(llpName) Then used.Add llpName, True
        Next s
    Next ws

    ' 未使用の LLP_* を削除（LLP_LINK は除外）
    For Each nm In ActiveWorkbook.Names
        If (nm.name Like "LLP_*") And (Not used.Exists(nm.name)) Then nm.Delete
    Next nm

    Application.StatusBar = "孤児リンクを削除しました。"
End Sub

Private Sub GotoSelected()
    Dim src As String

    ' 選択中の画像の参照範囲を取得
    On Error GoTo HANDLE_ERROR
    If (Selection.ShapeRange.Count <> 1) Then GoTo HANDLE_ERROR
    src = GetLlpSrcRangeOrEmptyS(Selection.ShapeRange(1))
    If Len(src) = 0 Then GoTo HANDLE_ERROR

    ' 選択範囲に移動
    Application.Goto Application.Range(src), True
    Exit Sub

HANDLE_ERROR:
    On Error GoTo 0
    Err.Raise 603, "llp goto ", "LLP 画像を1つだけ選択してください。"
End Sub

Private Sub LocalizeBookRefs()
    Dim nm As name
    Dim srcRange As String
    Dim srcRangeWoBk As String

    For Each nm In ActiveWorkbook.Names
        If nm.name = "LLP_LINK" Then GoTo NEXT_NAME
        If Not (nm.name Like "LLP_*") Then GoTo NEXT_NAME

        srcRange = GetLlpSrcRangeOrEmptyF(nm.RefersTo)
        If Len(srcRange) = 0 Then GoTo NEXT_NAME

        srcRangeWoBk = RemoveBookQualifier(srcRange)
        If srcRangeWoBk = srcRange Then GoTo NEXT_NAME

        nm.RefersTo = "=IF(LLP_LINK," & srcRangeWoBk & ","""")"
NEXT_NAME:
    Next nm

    Application.StatusBar = "LLP 画像から外部ブック名を削除しました。"
End Sub

' 画像から参照先の式を取得
Private Function GetFormulaOrEmpty(ByRef s As Shape) As String
    On Error Resume Next
    ' リンク付き画像は msoPicuture なので、 msoLinkedPicture は見なくて良い。
    If s.Type <> MSO_PICTURE Then Exit Function
    GetFormulaOrEmpty = Trim$(s.DrawingObject.formula)
    On Error GoTo 0
End Function

' LLP 管理下の Shape について、参照している名前を返す
Private Function GetLlpNameOrEmpty(ByRef s As Shape) As String
    Dim f As String
    f = GetFormulaOrEmpty(s)
    If f Like "LLP_*" Then GetLlpNameOrEmpty = f
    On Error GoTo 0
End Function


' LLP 管理下の Shape について、参照先の範囲を返す
Private Function GetLlpSrcRangeOrEmptyS(ByRef s As Shape) As String
    Dim nm As String
    Dim f As String
    nm = GetLlpNameOrEmpty(s)
    If Len(nm) = 0 Then Exit Function

    f = ActiveWorkbook.Names(Trim$(nm)).RefersTo
    GetLlpSrcRangeOrEmptyS = GetLlpSrcRangeOrEmptyF(f)
End Function

' LLP 式から参照先の範囲を取り出す
Private Function GetLlpSrcRangeOrEmptyF(ByRef f As String) As String
    Const PREFIX As String = "=IF(LLP_LINK,"
    Const SUFFIX As String = ","""")"
    If Not f Like (PREFIX & "*") Then Exit Function
    If Not f Like ("*" & SUFFIX) Then Exit Function
    GetLlpSrcRangeOrEmptyF = Mid$(f, Len(PREFIX) + 1, Len(f) - Len(PREFIX) - Len(SUFFIX))
End Function

' 範囲から 外部ブック修飾を除去
'  例:  "'[C:\path\[Book.xlsx]Sheet A'!$A$1" → "'Sheet A'!$A$1"
'       "[Book.xlsx]Sheet1!$A$1:$B$2"        → "Sheet1!$A$1:$B$2"
Function RemoveBookQualifier(ByRef RefText As String) As String
    Dim exclPos As Long
    Dim bracketPos As Long

    RemoveBookQualifier = RefText

    ' 末尾から ! を探す。
    exclPos = InStrRev(RefText, "!")
    If exclPos = 0 Then Exit Function

    ' ] を探す
    bracketPos = InStrRev(Left$(RefText, exclPos - 1), "]")
    If bracketPos = 0 Then Exit Function


    RemoveBookQualifier = Mid$(RefText, bracketPos + 1)

    ' ! の直前がシングルクォートなら、 ' 頭に ' を付与
    If Mid$(RefText, exclPos - 1, 1) = "'" Then
        RemoveBookQualifier = "'" & RemoveBookQualifier
    End If
End Function

 llp の使い方llp には6つのサブコマンドがあります。


サブコマンド
短縮形
機能概要


insert
i
コピー中の範囲から新しい LLP を作成する。

update
u
すべての LLP を更新する。

migrate
m
ブック中のリンクされた図をすべて LLP に変換する。

clean
c
使われなくなった LLP 関連の名前を削除する。

goto
g
選択中の LLP が参照している範囲に移動する。

localize
l
ブック中のすべての LLP の参照範囲から外部ブック名を取り除く。


 insertinsert はコピー中の範囲を参照する LLP を作成するコマンドです。
(マクロの実行には自作のマクロランチャーを利用しています。)

 updateupdate は LLP の描画を更新するコマンドです。

 migratemigrate はブック内のリンクされた図すべてを LLP に置き換えるコマンドです。

 cleanclean は使われなくなった LLP 関連の名前を削除する機能です。

各 LLP には対応する名前があるのですが、 LLP を消しても名前は残ってしまいます。 clean はこれを掃除します。

 gotogoto は選択中の LLP の参照先に飛ぶ機能です。

通常のリンクされた図と異なり、 LLP はダブルクリックしても参照先に飛べません。代わりに goto を使います。

 localizelocalize は LLP の参照先からブック名の指定を削除するコマンドです。

LLP をブック間でコピーすると、 LLP の維持に必要な名前もコピーされます。しかし、参照先にはコピー元のブック名が付与されてしまいます。これを排除するために localize を使います。

 llp のしくみここまでは llp コマンドの機能を紹介してきました。

ここでは LLP を手動で作成する方法を通じて、その仕組みを説明します。
LLP を手動で作成する手順は次のとおりです。
リンクされた図を挿入する。
図の参照先を取得する。

LLP_LINK という名前を作り、値を TRUE にセットする。

LLP_1 という名前を作り、値を IF(LLP_LINK, <2で取得した式>, "") にセットする。
図の参照先を LLP_1 に差し替える。

LLP_LINK の値を FALSE にする。
これをコードにしたものが上記の InsertLlp プロシージャです。図が参照している LLP_1 は、 LLP_LINK が真の時には範囲として評価され、偽のときは空文字列として評価されます。図が再描画されるのは参照先が有効な時だけです。そのため、 LLP_LINK の値で LLP の再描画を制御することができるのです。
ちなみに、式を設定する瞬間は式が範囲として評価される必要があります。そのため、3の時点で LLP_LINK を FALSE にすると、5でエラーになります。

 終わりに本稿では、 Excel の「リンクされた図」が重い問題への対処として、図の更新を手動化するマクロを紹介しました。リンクされた図の多用で重くなった Excel ブックが手元にある方は、 llp migrate で直ちに効果を実感できることでしょう。ぜひお試しください。以上、ありがとうございました。
サブコマンド	短縮形	機能概要
insert	i	コピー中の範囲から新しい LLP を作成する。
update	u	すべての LLP を更新する。
migrate	m	ブック中のリンクされた図をすべて LLP に変換する。
clean	c	使われなくなった LLP 関連の名前を削除する。
goto	g	選択中の LLP が参照している範囲に移動する。
localize	l	ブック中のすべての LLP の参照範囲から外部ブック名を取り除く。
はじめに

用語定義

llp の導入

llp の使い方

insert

update

migrate

clean

goto

localize

llp のしくみ

終わりに

Discussion
