エクセル2000です。
ワークシート上にオートシェープの楕円を5個配置してあります。
それぞれ名前をOval_1~Oval_5と設定しました。
それぞれは以下のマクロを組み込み、クリックにより破線、実線と変更します。実線が選択されたしるしとします。
Oval_1~Oval_3で1グループ、Oval_4~Oval_5で1グループとし、それぞれのグループ内で1個の楕円しか選べないようにしたいのです。
一応、希望通りの動きはするのですが、何かすっきりしません。
もっと気の利いたコードはないでしょうか?
Sub Oval_Check()
With ActiveSheet
If .Shapes(Application.Caller).Line.DashStyle = msoLineSolid Then 'クリックしたのが実線なら
.Shapes(Application.Caller).Line.DashStyle = msoLineSquareDot ' 破線に
Select Case Application.Caller 'クリックしたのが
Case "Oval_4" 'Oval_4なら
.Shapes("Oval_5").Line.DashStyle = msoLineSolid 'Oval_5を実線に
Case "Oval_5" 'Oval_5なら
.Shapes("Oval_4").Line.DashStyle = msoLineSolid 'Oval_4を実線に
End Select
Else 'そうでないなら
.Shapes(Application.Caller).Line.DashStyle = msoLineSolid ' 実線に
Select Case Application.Caller 'クリックしたのが
Case "Oval_1" 'Oval_1なら
.Shapes.Range(Array("Oval_2", "Oval_3")).Line.DashStyle = msoLineSquareDot 'Oval_2,Oval_3を破線に
Case "Oval_2" 'Oval_2なら
.Shapes.Range(Array("Oval_1", "Oval_3")).Line.DashStyle = msoLineSquareDot 'Oval_1,Oval_3を破線に
Case "Oval_3" 'Oval_3なら
.Shapes.Range(Array("Oval_1", "Oval_2")).Line.DashStyle = msoLineSquareDot 'Oval_1,Oval_2を破線に
Case "Oval_4" 'Oval_4なら
.Shapes("Oval_5").Line.DashStyle = msoLineSquareDot 'Oval_5を破線に
Case "Oval_5" 'Oval_5なら
.Shapes("Oval_4").Line.DashStyle = msoLineSquareDot 'Oval_4を破線に
End Select
End If
End With
End Sub
No.2ベストアンサー
- 回答日時:
こんな風にまとめてみました。
Sub Oval_Check()
Dim ov1 As String, ov2 As String, ov3 As String
Dim ov4 As String, ov5 As String
Dim ov As String
Dim ova As Variant, ovb As Variant
ov1 = "Oval_1": ov2 = "Oval_2": ov3 = "Oval_3"
ov4 = "Oval_4": ov5 = "Oval_5"
With ActiveSheet.Shapes
ov = Application.Caller 'クリックした図形の
' 線の種類を取得
Select Case .Range(ov).Line.DashStyle '線の種類が
Case msoLineSolid '実線の場合
ova = msoLineSolid
ovb = msoLineSquareDot
Case msoLineSquareDot '点線の場合
ova = msoLineSquareDot
ovb = msoLineSolid
End Select
' 線の種類を変更
Select Case ov 'クリックした図形が
Case ov1, ov2, ov3 'の場合
.Range(Array(ov1, ov2, ov3)).Line.DashStyle = ova
Case ov4, ov5 'の場合
.Range(Array(ov4, ov5)).Line.DashStyle = ova
End Select
.Range(ov).Line.DashStyle = ovb
End With
End Sub
ありがとうございます。
とても参考になりました。
ただ、Oval_1~Oval_3で三択、Oval_4~Oval_5で二択なのですが、ご教示のものではOval_1~Oval_3の三択の部分で、実線(選択された状態)の楕円をクリックし、破線に変えると残る2つが実線に変わってしまい、三択になりません。
No.8
- 回答日時:
>回答番号:No.7 この回答へのお礼
>For Each sp In ActiveSheet.Shapes
>MsgBox sp.Name
>Next
>とやってみたところ、出てくるのはグループ名のみで、
GroupItemsプロパティを使えば、多分Excel2000でも、Group内の個々の図形に処理ができるようです。
あるいは(無意味かも知れませんが)、一旦Group化を解除して処理を実行後、再グループ化する手があると思います。
TypeName関数 とか、Typeプロパティを使って、戻り値でGroup化されているかどうか判定し、処理を分岐すれば良いとおもいます。
No.7
- 回答日時:
Group化した図形、単独でGroupの図形、単独図形、が混在する場合に対応してみました。
前提条件として、
図形に、「A-1、A-2、A-3」、「B-1、B-2」のようにグループ分けが容易な名前を付ける。
というように考えています。
グループに属さない、単独の図形の場合は、実線と破線に交互に切り替えるようにしています。
Sub test3()
Dim shp As Object
Dim sn As String
Dim ov As String
Dim dsh As Long
Dim i As Long
Dim n As Long
ov = Application.Caller 'クリックされた図形
sn = Split(ov, "_")(0)
dsh = ActiveSheet.Shapes.Range(ov).Line.DashStyle
For Each shp In ActiveSheet.Shapes
On Error Resume Next
n = shp.GroupItems.Count
On Error GoTo 0
If n <> 0 Then
For i = 1 To n
If shp.GroupItems(i).Name Like sn & "*" Then
shp.Line.DashStyle = msoLineSquareDot
Exit For
End If
Next i
ElseIf n = 0 Then
If shp.Name <> ov And shp.Name Like sn & "*" Then
shp.Line.DashStyle = msoLineSquareDot
End If
End If
n = 0
Next
With ActiveSheet.Shapes.Range(ov)
Select Case dsh
Case msoLineSquareDot: .Line.DashStyle = msoLineSolid
Case msoLineSolid: .Line.DashStyle = msoLineSquareDot
End Select
End With
End Sub
明けましておめでとうございます。
お正月休みでお返事が遅くなり申し訳ございませんでした。
何度もありがとうございます。
グループ化しての方法、とても興味があります。
ただ、わたしのエクセル2000だと、
回答番号:No.6
ActiveSheet.Shapes.Range(ov).Line.DashStyle = msoLineSolid
回答番号:No.7
dsh = ActiveSheet.Shapes.Range(ov).Line.DashStyle
が実行時エラー1004「指定した名前のアイテムがみつかりませんでした」となってしまいます。
ためしに
For Each sp In ActiveSheet.Shapes
MsgBox sp.Name
Next
とやってみたところ、出てくるのはグループ名のみで、グループ化された個々のオブジェクトはとらえられないようです。
No.6
- 回答日時:
こんな風になりました。
対象図形が、グループ化されていることが前提条件です。
取りあえず、For~Nextしています。
クリックされた図形が属する、Groupを、もっと簡単に特定できる方法を探しています。
Sub test1()
Dim ov As String
Dim myf As Boolean
Dim i As Long
Dim j As Long
Dim n As Long
ov = Application.Caller
For i = 1 To ActiveSheet.Shapes.Count
myf = False
With ActiveSheet.Shapes(i)
On Error Resume Next
n = .GroupItems.Count
On Error GoTo 0
If n >= 2 Then
For j = 1 To .GroupItems.Count
If .GroupItems(j).Name = ov Then
.Line.DashStyle = msoLineSquareDot
myf = True
Exit For
End If
Next j
If myf = True Then Exit For
End If
End With
n = 0
Next i
ActiveSheet.Shapes.Range(ov).Line.DashStyle = msoLineSolid
End Sub
No.5
- 回答日時:
こんにちは。
>おっしゃるとおり本来はオプションボタンで対応すべきことなのです。
私は、そういうように考えているのではなく、コードの標準化です。
クラス・インスタンスも考えたのですが、グループ別けのプロパティを加えることができないように思いました。もしかしたら、可能かもしれませんが、簡単な方法を選びました。
#1さん曰く
>プログラムは貴方のソースコードのように
>ベタ書きになってしまい、設問が100個もあると、ソースコードは
>600~1000行ぐらいにはなるのでは?と思います。
に呼応して、コードを書いたまでです。
オプションボタンの仕様を借りれば、設問が増えても、コードは増えないです。ご質問のコードでは、設問が増えれば、どんどん書き加えなくてはならないはずです。そういうことは問題ではなさそうですね。
#2さんのコードも、ただ、1行を加えればよいだけですよね。
明けましておめでとうございます。
お正月でお返事が遅くなり申し訳ございませんでした。
今回は対象数が少ないので問題はありませんでしたが、多くなった場合のために勉強させていただきます。
いつも為になるご指導をいただきありがとうございます。
No.4
- 回答日時:
> Oval_1~Oval_3で1グループ、Oval_4~Oval_5で1グループとし、
> それぞれのグループ内で1個の楕円しか選べないようにしたいのです。
上記、仕様に沿っていると思います。
オリジナルのコードとも、同じ動作になっています。
どうなって欲しいのですか?
制約は設けていませんので、御気に召すよう改編改修していただいて結構ですよ。
何度もありがとうございます。
.Range(Array(ov1, ov2, ov3)).Line.DashStyle = ova
の部分で、実線の楕円をクリックするとその楕円が破線になり、残りの2つが実線となってしまいます。わたしの書き方が悪いのですが「1個の楕円しか選べないように」の意味はグループ内で1個の楕円しか実線にならないようにの意味です。
でもNo3のお礼に書いたコードでうまくいきました。
ありがとうございました。
No.3
- 回答日時:
こんにちは。
>Oval_1~Oval_3で1グループ、Oval_4~Oval_5で1グループとし、それぞれのグループ内で1個の楕円しか選べないようにしたいのです。
ご質問の内容って、OptionButton の働きがあればよいのではありませんか?
OptionButton をオートシェイプの数(枝番をあわせます)だけ、シートの片隅に作って、グループ名で分ければよいと思います。気の利いているのかは判りませんが、難しく考える必要もありませんね。
いくら、丸の数が増えても、オプションボタン側で設定すればよいので、以下のマクロは変わりません。
OnAction に、手動でマクロを付けるのは面倒なので、設定用のマクロを設けました。
理屈は、ひとつのオートシェイプ側から、オプションボタンを設定して、後は、逆にオプションボタンから、全てのオートシェイプを反映させます。
注意:OptionButtonのプロパティのグループ名を、きちんと分けてください。
例 Sheet1 -> Group1, Group2, Group3
あまり、数が多いようなら、グループ名だけで分岐してもよいと思います。
'標準モジュール(シートモジュールなら、ActiveSheet は、Meキーワード)
Sub SetOnAction()
'設定用
Dim shp As Variant
For Each shp In ActiveSheet.Shapes
If shp.Name Like "Oval_#*" Then
shp.OnAction = "Oval_Op"
End If
Next shp
End Sub
'-----------------------------------------
Sub Oval_Op()
Dim i As Variant
Dim j As Integer
Dim nshp As String
Dim grp As String
i = Replace(Application.Caller, "Oval_", "")
If VarType(Application.Caller) = vbString Then
nshp = Application.Caller
Else
Exit Sub
End If
With ActiveSheet 'Me
If IsNumeric(i) Then
chgLineStyle nshp, i
End If
End With
End Sub
Sub chgLineStyle(nshp As String, i As Variant)
Dim j As Integer
Dim shp as Variant
With ActiveSheet 'Me
If .OLEObjects("OptionButton" & i).Object.Value = False Then
.Shapes(nshp).Line.DashStyle = 1
.OLEObjects("OptionButton" & i).Object.Value = True
End If
For Each shp In .Shapes
If shp.Name Like "Oval_#*" Then
j = Replace(shp.Name, "Oval_", "")
If .OLEObjects("OptionButton" & j).Object.Value Then
.Shapes(shp.Name).Line.DashStyle = 1
Else
.Shapes(shp.Name).Line.DashStyle = 2
End If
End If
Next
End With
End Sub
ありがとうございます。おっしゃるとおり本来はオプションボタンで対応すべきことなのです。しかし、No1さんのお礼にも書きましたようにクリックした箇所の破線のマルを実線のマルにビジュアルに変えることが必要なのです。でもよく考えると本来のオプションボタンならすでにオンのものをクリックしても変化しませんよね。なら楕円だってそうすればいいわけで、実線の楕円をクリックしたらExitするようにしたらすっきりしました。
Sub Oval_Check()
Dim ov As String
With ActiveSheet
ov = Application.Caller
If .Shapes(ov).Line.DashStyle = msoLineSolid Then 'クリックしたのが実線なら
Exit Sub '終了
Else '破線なら
Select Case ov 'クリックしたのが
Case "Oval_1", "Oval_2", "Oval_3" 'Oval_1~3なら
.Shapes.Range(Array("Oval_1", "Oval_2", "Oval_3")).Line.DashStyle = msoLineSquareDot 'Oval_1~3を破線に
Case "Oval_4", "Oval_5" 'Oval_4~5なら
.Shapes.Range(Array("Oval_4", "Oval_5")).Line.DashStyle = msoLineSquareDot 'Oval_4~5を破線に
End Select
.Shapes(ov).Line.DashStyle = msoLineSolid 'クリックしたのを実線に
End If
End With
End Sub
No.1
- 回答日時:
なんとなく。
Excelでビジュアルなアンケート用紙みたいなものを作りたい?
…と察しますが。
Excelで画面制御バリバリの固定入力フォームを作るとなると、
ツール的にしんどい面があるかな?と思います。
特にShapeを使うと見た目は綺麗ですが、効率的に使えるセル座標系
関数が全く使えないので、プログラムは貴方のソースコードのように
ベタ書きになってしまい、設問が100個もあると、ソースコードは
600~1000行ぐらいにはなるのでは?と思います。
また、この設問シートが多人数に配布され、あとで集計されるもので
あれば、集計は人間の手作業になりしんどいことになると思います。
もし、しっくりしない点が以上のようなことであれば。
どうしても、Excelを使うならば、一つの方法は、設問と入力場所を
変えることとExcelセル関数で片付けてしまうこと。
例えば、貴方の設問には
・グループ選択肢
・ON / OFF
・自由入力
の3要素がありますが。
提示画像のShapeのある位置に、=IF(Ax=1,"1","(1)")のような関数を
埋めて、右の方の別セルに回答欄を持ってくる。
その回答欄Ax座標に「1」が入っていれば(1)、それ以外は1と表示
するようにする。
マクロでチェックさせるなら、回答のチェックボタンを作成し、
回答欄Ax座標の論理解釈とErrorメッセージを表示…としてしまう。
そうすると、回答欄列のみ別シートへコピペすると、集計は適当な
セル関数で可能です。
(ま、強引にShape名をString関連の関数とVBでゴソゴソ捏ねるのも
いいのですけど。)
もしくは。
そもそも違うツールを使ってしまう。
FileMakerやAccessあたりで組んでしまう方が早いかもしれません。
Excelはあくまで、対セルに対する参照系関数が第一の醍醐味で。
VBAはその論理的解析や結果に対する制御に向くので、
UIの完全制御を求めると膨大なコード量を必要としたり、変更に
弱かったり、いろいろ手数は要ると思います。
とはいえ、やってみることは大事なことなので。
いいチャレンジだとは思います。
私も入門当時はExcelマクロでしたので。
今回のはアンケート用紙のような集計を目的とするものではなく、本来ならオプションボタンを用いるところを、クリックした箇所の破線のマルを実線のマルにビジュアルに変えることが必要なのです。
でも、貴重なご意見とても勉強になりました。
ありがとうございます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 英語 The superior extent of a sloping anterior wall may 3 2023/03/09 13:55
- 魚類 水槽照明の買い替えを検討中の初心者です。コスパが良いものがあれば教えてください! 1 2022/09/16 17:34
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) 【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする 5 2022/03/26 18:31
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) いつもお世話になります 下記のコード実行すると エラーになります わかるかた教えてくれませんでしょう 6 2022/12/17 15:01
- Visual Basic(VBA) Excel vbaについての質問 3 2023/04/18 16:14
- Visual Basic(VBA) select caseの入れ子 3 2023/03/08 18:48
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
グーグルスプレッドシートの図...
-
線を組み合わせた図形の塗りつ...
-
PowerPointで台形を描く方法
-
クリックしたらパネルがめくれ...
-
エクセルで図形を連動させたい
-
Metasequoia(メタセコイア)で...
-
図形でしずく型を作りたい
-
Illustratorでくくり括弧記号を...
-
ExcelのVBAコードについて教え...
-
Illustratorで白い部分のみを透...
-
pdf上に描画した図形が印刷され...
-
エクセルVBAで図形のテキストを...
-
fractileって?日本語では何で...
-
【VBA】3個の図形をコピーしてS...
-
簡単な絵が描けるソフト(word...
-
エクセルマクロを使って図形を...
-
WORDで図に網掛けする方法は?
-
おしえてgooに図形の問題を投稿...
-
これらの問題がわかりません
-
【Excel】エクセルでグループ化...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
PowerPointで台形を描く方法
-
線を組み合わせた図形の塗りつ...
-
グーグルスプレッドシートの図...
-
pdf上に描画した図形が印刷され...
-
AutoCADで渦巻きを描く方法
-
Excel のバージョンによって、...
-
ワードかエクセルの図形を使っ...
-
Illustratorでくくり括弧記号を...
-
Illustratorで白い部分のみを透...
-
図形でしずく型を作りたい
-
エクセルで図形を連動させたい
-
エクセル ユーザーフォームに...
-
ExcelのVBAコードについて教え...
-
クリックしたらパネルがめくれ...
-
Excel2003図-扇形を書く方法は...
-
おしえてgooに図形の問題を投稿...
-
Jw-cad の図形リストが表示でき...
-
ワードの基本図形で 角丸四角と...
-
【VBA】3個の図形をコピーしてS...
-
エクセルVBAで図形のテキストを...
おすすめ情報