Excel で図形をデフォルトに戻す

Excel で図形をデフォルトに戻す

仕事で使用している計画文書には約 70 個の図形があり、すべて問題ありませんが、新しい機能を追加しようとしています。これらの図形は、毎週編集ポイントを使用して変更され、マップに表示されますが、図形「A」が使用されない場合があります。その場合は、他のすべての図形とともに既定のサイズに戻したいだけです。マクロを使用してこれを実現する方法を誰か知っていますか。いろいろ試し、あらゆる場所を検索しましたが、途方に暮れています...

図形がデフォルトでない場合は、すべての非デフォルトの図形をデフォルトのサイズに設定します。

前もって感謝します

答え1

Excel が図形のデフォルトの高さと幅をどこに保存するかはわかりません。デフォルトとは、ドラッグしてサイズを変更するのではなく、クリックして配置する場合の図形のサイズを意味していると思います。たとえば、楕円は 72 x 72 です。正方形も同様です。

これを行う 1 つの方法は、図形の AlternativeText プロパティを使用することです。このプロパティに既定のサイズを保存できます。図形を右クリックし、[オートシェイプの書式設定] を選択して、[Web] タブに移動し、「72|72」と入力します。パイプを幅と高さの区切りとして使用しています。図形の種類ごとに既定のサイズを把握する必要がありますが、前述したように Excel がそれをどこに保存するかはわかりません。AlternativeText プロパティを設定したら、次のようなコードを使用できます。

Sub FixShape()

    Dim shp As Shape
    Dim vaDefault As Variant

    Const sDELIM = "|"

    For Each shp In Sheet1.Shapes
        If Len(shp.AlternativeText) > 0 Then
            vaDefault = Split(shp.AlternativeText, sDELIM)
            shp.Width = vaDefault(0)
            shp.Height = vaDefault(1)
        End If
    Next shp

End Sub

これにより、AlternativeText に何かが含まれるすべての図形が、記録した幅と高さに設定されます。これは、AlternativeText を他の目的で使用していないことを前提としています。

AlternativeTextを使用して保存したくない場合は、VBAで値をハードコードすることができます。

Sub FixShape2()

    Dim shp As Shape

    Const lDEFOVALHEIGHT As Long = 72
    Const lDEFOVALWIDTH As Long = 72
    Const lDEFSQRHEIGHT As Long = 72
    Const lDEFSQRWIDTH As Long = 72

    For Each shp In Sheet1.Shapes
        Select Case shp.AutoShapeType
            Case msoShapeOval
                shp.Height = lDEFOVALHEIGHT
                shp.Width = lDEFOVALWIDTH
            Case msoShapeRectangle
                shp.Height = lDEFSQRHEIGHT
                shp.Width = lDEFSQRWIDTH
        End Select
    Next shp

End Sub

関連情報