構成図自動結線マクロ（その４）一括削除と１つ削除
2021年09月21日
今回もオートシェープの自動結線マクロの話。
挿入したコネクタがイメージと違ったなんてことよくある。
一括で挿入したものを１つずつ消すのは辛い。
手動操作ならUnDo（Ctrl+z）が効くが、マクロだと戻せないので
削除機能を実装してみた。
現在選択中のオブジェクトがいくつあるから・・・なんで複数なことをやろうとしたけど、
名称に設定した通番の最大値をもつオブジェクトを調べて消すだけじゃん。
通番管理でコネクタの挿入処理は複雑になったけど、しゃーない。
名称は、 "myCn_" で始まるように統一したので、"myCn_"を含むオブジェクトを全削除する機能も実装。
ちなみにオートシェープの一覧はAlt＋F10で確認ができる。
以下、ソース。
挿入したコネクタがイメージと違ったなんてことよくある。
一括で挿入したものを１つずつ消すのは辛い。
手動操作ならUnDo（Ctrl+z）が効くが、マクロだと戻せないので
削除機能を実装してみた。
現在選択中のオブジェクトがいくつあるから・・・なんで複数なことをやろうとしたけど、
名称に設定した通番の最大値をもつオブジェクトを調べて消すだけじゃん。
通番管理でコネクタの挿入処理は複雑になったけど、しゃーない。
名称は、 "myCn_" で始まるように統一したので、"myCn_"を含むオブジェクトを全削除する機能も実装。
ちなみにオートシェープの一覧はAlt＋F10で確認ができる。
以下、ソース。
Sub つないだコネクタを消す()
Dim maxNum As Long, tarNum As Long
Dim spPos As Long, shapeName As String, maxShape As Shape
Dim i As Long
For i = 1 To ActiveSheet.Shapes.Count 'シート内の名前をチェック
shapeName = ActiveSheet.Shapes(i).Name
If Left(shapeName, 5) = "myCn_" Then
spPos = InStrRev(shapeName, " ")
tarNum = Mid(shapeName, spPos + 1, 4)
If tarNum > maxNum Then
maxNum = tarNum 'tarnumの最大値を探す
Set maxShape = ActiveSheet.Shapes(i)
End If
End If
Next i
If maxShape Is Nothing Then
Else
maxShape.Delete
End If
End Sub
Sub 自動作成したコネクタを全削除()
Dim i As Long, tarShape As Shape, BeginShape As Shape, EndShape As Shape
For i = ActiveSheet.Shapes.Count To 1 Step -1
Set tarShape = ActiveSheet.Shapes(i)
If Left(tarShape.Name, 5) = "myCn_" Then
tarShape.Delete
End If
Next i
End Sub
PR
Comment