Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


63729 / 76732 ←次へ | 前へ→

【17597】Re:図形描画
回答  かみちゃん  - 04/9/3(金) 7:22 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 1 現在使用している直線の番号(直線96であれば96のこと)がわかる方法。

図形をひとつだけ選択して下記マクロを実行してみてください。
もっといい方法があるかわかりませんが・・・
Sub Macro1()
 If VarType(Selection) = vbObject Then
  MsgBox "名前は " & Selection.Name & vbCrLf & _
       "番号は " & Replace(Selection.Name, TypeName(Selection) & " ", "")
 Else
  MsgBox "オブジェクトが選択されていません", vbCritical
 End If
End Sub

> 2 直線を引くとき、番号が1(または0)から始まるように、リセットする方法。
> 3 または、もっと良い方法

すでにichinoseさんからもコメントがついていますが別解ということで。

'選択したセル範囲内の特定の種類の図形だけを削除する
'参考URL
' http://park11.wakwak.com/~miko/Excel_Note/17-03_zukei.htm#17-03-47
Sub Macro1()
 Dim myShp As Shape
 Dim myR As Range, SR As Range
 On Error Resume Next
 Set myR = Selection
' 特定のセル範囲であれば次のように記述
' Set myR = Range("A1:D50")
 If Err.Number <> 0 Then Exit Sub
 On Error GoTo 0
 For Each myShp In ActiveSheet.Shapes
  Set SR = Range(myShp.TopLeftCell, myShp.BottomRightCell)
  If Not Intersect(SR, myR) Is Nothing Then
   '選択範囲内に「完全に含まれる」場合は削除する場合は次のIfステートメントで制御
   '選択範囲内と「部分的に重なる」場合も削除する場合は次のIfステートメントは不要
   If Intersect(SR, myR).Cells.Count = SR.Cells.Count Then
    '直線(msoLine)の場合削除する
    If myShp.Type = msoLine Then myShp.Delete
   End If
  End If
  Set SR = Nothing
 Next
 Set myR = Nothing
End Sub
0 hits

【17594】図形描画 かっちゃん 04/9/3(金) 6:17 質問
【17595】Re:図形描画 ichinose 04/9/3(金) 6:53 発言
【17597】Re:図形描画 かみちゃん 04/9/3(金) 7:22 回答

63729 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free