Excel VBA質問箱 IV

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

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


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

4515 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

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

【56172】Re:図形選択数によってエラー りん 08/6/7(土) 6:39

【56174】Re:図形選択数によってエラー kobasan 08/6/7(土) 7:24


	【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


	【56172】Re:図形選択数によってエラー

りん

- 08/6/7(土) 6:39 -


	引用なし

	パスワード

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

For Each～で、コレクションのアイテムが１つでもループ処理ができますが、コレクションでない場合（今回はTextBox）をループしようとするとエラーになります。

Selectionの内容で分岐して処理するようにしました。

Sub Set_PrintObject()
　 Dim sh As Object
　 '
　 Select Case TypeName(Selection)
　　　Case "Range":　　　 '何もしない
　　　Case "DrawingObjects"
　　　　 For Each sh In Selection
　　　　　　Sh_Set sh　　 '複数オブジェクトならループしながらコール
　　　　 Next
　　　Case Else
　　　　 Sh_Set Selection '単体オブジェクトならそのままコール
　 End Select
End Sub
'////////////////////////////////
Sub Sh_Set(sh As Object)
　 '実働部分：テキストボックスにいろいろ設定（分離しただけ）
　 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
End Sub

こんな感じです。


	【56174】Re:図形選択数によってエラー

kobasan - 08/6/7(土) 7:24 -


	引用なし

	パスワード

りんさん、おはようございます。

>For Each～で、コレクションのアイテムが１つでもループ処理ができますが、コレクションでない場合（今回はTextBox）をループしようとするとエラーになります。

これ知りませんでした。図形について詳しくない者にとっては微妙ですね。
勉強になりました。

>　　　Case "DrawingObjects"

図形を２つ以上選択したとき、これで対応ができるんですね。
これも勉強になりました。
回答をいただき、すっきりしました。
りんさん、ありがとうございました。

>Selectionの内容で分岐して処理するようにしました。
>
>Sub Set_PrintObject()
>　 Dim sh As Object
>　 '
>　 Select Case TypeName(Selection)
>　　　Case "Range":　　　 '何もしない
>　　　Case "DrawingObjects"
>　　　　 For Each sh In Selection
>　　　　　　Sh_Set sh　　 '複数オブジェクトならループしながらコール
>　　　　 Next
>　　　Case Else
>　　　　 Sh_Set Selection '単体オブジェクトならそのままコール
>　 End Select
>End Sub


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

4515 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free