argius note

プログラミング関連

Excel 見えないシェイプ(図形)で肥大化したファイルをなんとかする

修正を依頼されたExcelファイルが10MB近くあったので、画像が大量にはりつけられているのかと思ったら、そうでもない。どうみても、1MBにもならないような内容。
不要な名前定義*1も疑いましたが、これが多少あったところでせいぜい1MB。9MBも肥大したりしないはずです。
残るは、「見えない」シェイプ(図形)が大量に埋め込まれているという可能性。見えないシェイプは、次のように埋め込まれます。

  1. 行削除したとき、その行に「サイズも変更する」プロパティになっているシェイプが含まれていると、高さゼロのシェイプが消えずに残る。
  2. 高さゼロのシェイプは、通常は見えない。矢印で選択したりすると見える。普通の人は気づかない。
  3. 気づかないまま、行のコピーで複製され、気づかぬうちにファイルサイズが大きくなる。

見えなくても大量にシェイプがあるシートは重いので、それで気づく人は気づきます。


案の定、99.99%不要と思われる高さゼロのテキストボックスが10,000超見つかりました。それも、1シートに付き10,000。ちゃんと数えてませんが、全部で40,000くらいあったかも知れません。消したら、300KBくらいになりました。
今回はパターンが単純だったので、手動で済みました。でも、見えないシェイプが何処にあるかがはっきりしないような場合は、マクロでやってしまうと良いでしょう。
というわけで、事後でしたが、VBAマクロを書いてみました。幅か高さの閾(しきい)値より小さいもの、を「見えない」シェイプとして検出します。最初に数を数えて、見つかった場合は「パターンを赤くしてサイズを大きくする」かどうかを確認して、OKすると、見つかった見えないシェイプを、見えるように「パターンを赤くしてサイズを大きく」します。
2009.08.06追記: version2

  • 「見えない」判定を関数にまとめた
  • サイズが閾値以下で、シェイプの種類が「線」の場合は除外
  • シェイプの塗りつぶしと線が不可視の場合は、下記を除いて、サイズに関係なく「見えない」とする
    • テキストボックス(msoTextBox)が空(trimした値が空文字列)
    • 図(msoPicture)
Sub 見えない図形を見えるようにする()
    ' 内部サイズはcmの約28倍?
    Const 幅のしきい値 As Integer = 5 '0.34cm
    Const 高さのしきい値 As Integer = 5 '0.34cm
    If Not MsgBox("見えない図形を数えます。", vbOKCancel) = vbOK Then
        Exit Sub
    End If
    Dim shp As Shape
    Dim c As Integer
    For Each shp In ActiveSheet.Shapes
        If 見えない図形とみなす(shp, 幅のしきい値, 高さのしきい値) Then
            c = c + 1
        End If
    Next
    If c = 0 Then
        MsgBox "見えない図形はありませんでした。"
        Exit Sub
    ElseIf Not MsgBox("見えない図形は、" & c & "個ありました。" & vbNewLine & _
                  "見えるように「赤く大きく」しますか?" & vbNewLine & _
                  "(数によっては処理時間がかかります。)", vbOKCancel) = vbOK Then
        Exit Sub
    End If
    For Each shp In ActiveSheet.Shapes
        If 見えない図形とみなす(shp, 幅のしきい値, 高さのしきい値) Then
            If shp.Width < 幅のしきい値 Then
                shp.Width = 10 ' 0.71cm
            End If
            If shp.Height < 高さのしきい値 Then
                shp.Height = 10 ' 0.71cm
            End If
            shp.Fill.ForeColor.SchemeColor = 10 ' 赤
            shp.Fill.Visible = msoTrue ' 念のため
            shp.Fill.Solid ' 念のため
        Else
            shp.Visible = msoFalse
        End If
    Next
    MsgBox "終了しました"
End Sub

Private Function 見えない図形とみなす(shp As Shape, 幅のしきい値, 高さのしきい値) As Boolean
    Dim result As Boolean
    result = False
    If shp.Width < 幅のしきい値 Or shp.Height < 高さのしきい値 Then
        If Not shp.Type = msoLine Then
            ' シェイプ≠線
            result = True
        End If
    ElseIf shp.Line.Visible = msoFalse And shp.Fill.Visible = msoFalse Then
        ' 線と塗りつぶしが不可視
        If shp.Type = msoTextBox Then
            If Trim(shp.TextFrame.Characters.Text) = "" Then
                ' テキストボックスの場合でテキストが空
                result = True
            End If
        ElseIf shp.Type = msoPicture Then
            result = False
        Else
            result = True
        End If
    End If
    見えない図形とみなす = result
End Function

*1:メニュー:挿入-名前-定義とたどると「名前の定義」が見られます。名前の定義が大量に含まれたファイルをコピーして流用したりすると、不要な名前の定義が「感染」していきます。これを削除するマクロもあるのですが、私が作ったものではないのでここでは公表できません。