Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

25902 / 76736

←次へ　｜　前へ→


	【56171】図形選択数によってエラー

kobasan - 08/6/7(土) 0:14 -


	引用なし

	パスワード

シート上のRectangle図形のPrintObject を変更させるために、下記
Set_PrintObject
を実行すると、図形を１つ選択時はエラーが発生し、図形を２つ以上選択時ではエラーは出ません。
(エラー内容：オブジェクトは、このプロパティまたはメソッドをサポートしていません)

図形の選択数に関係なく動作できるようにするために
Set_PrintObject2
のようにすると、エラーなく動くのですが、スマートではありません。
もっと良い方法があればお願いします。
それと、
Dim sh As Object　　'<===●
の変数宣言は、Objectで適切なのでしょうか。
よろしくお願いします。

Sub Set_PrintObject()
Dim sh As Object　　'<===●
　 'MsgBox TypeName(Selection)
　　If TypeName(Selection) = "Range" Then Exit Sub
　　
　　For Each sh In Selection　　'<===●図形１つ選択時、ここでエラー●
　　　　If TypeName(sh) = "TextBox" Then　'Rectangle
　　　　　　With sh
　　　　　　　　.PrintObject = Not .PrintObject '印刷する True　'印刷しない　False
　　　　　　　　Select Case .PrintObject
　　　　　　　　　　Case True: .ShapeRange.Fill.ForeColor.SchemeColor = 1 '1白
　　　　　　　　　　Case Else: .ShapeRange.Fill.ForeColor.SchemeColor = 41 'うすい青
　　　　　　　　End Select
　　　　　　End With
　　　　End If
　　Next
End Sub

Sub Set_PrintObject2()
Dim sh As Object
　 'MsgBox TypeName(Selection)
　　If TypeName(Selection) = "Range" Then Exit Sub
　　Select Case Selection.ShapeRange.Count
　　　　Case Is = 1: 枠1の印刷ON_OFF
　　　　Case Is > 1: 枠2の印刷ON_OFF
　　End Select
End Sub

Sub 枠1の印刷ON_OFF()　 '図形を１つ選択したとき
Dim sh As Object
　 'MsgBox TypeName(Selection)
　　If TypeName(Selection) = "Range" Then Exit Sub
　　If TypeName(Selection) = "TextBox" Then　'Rectangle
　　　　　　With Selection
　　　　　　　　.PrintObject = Not .PrintObject '印刷する True　'印刷しない　False
　　　　　　　　Select Case .PrintObject
　　　　　　　　　　Case True: .ShapeRange.Fill.ForeColor.SchemeColor = 1 '1白
　　　　　　　　　　Case Else: .ShapeRange.Fill.ForeColor.SchemeColor = 41 'うすい青
　　　　　　　　End Select
　　　　　　End With
　　End If
End Sub

Sub 枠2の印刷ON_OFF()　 '図形を２つ以上選択したとき
Dim sh As Object
　 'MsgBox TypeName(Selection)
　　If TypeName(Selection) = "Range" Then Exit Sub
　　For Each sh In Selection
　　　　If TypeName(sh) = "TextBox" Then　'Rectangle
　　　　　　With sh
　　　　　　　　.PrintObject = Not .PrintObject '印刷する True　'印刷しない　False
　　　　　　　　Select Case .PrintObject
　　　　　　　　　　Case True: .ShapeRange.Fill.ForeColor.SchemeColor = 1 '1白
　　　　　　　　　　Case Else: .ShapeRange.Fill.ForeColor.SchemeColor = 41 'うすい青
　　　　　　　　End Select
　　　　　　End With
　　　　End If
　　Next
End Sub

0 hits

▼

【56171】図形選択数によってエラー kobasan 08/6/7(土) 0:14

≪