仕事で使用している計画文書には約 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