Gizport
1 回答
0
Share (facebook)
55
view
全般

マクロ設定方法について 3つの項目からひとつをダブルクリックで選択し...

マクロ設定方法について 3つの項目からひとつをダブルクリックで選択しすると丸で囲まれるというマクロを作成しました。
逆に同じことをすると丸が消えます。

D9・E9・F9(Gとセルを結合しています)この三箇所にそれぞれひとつずつ項目を設けておりどれか選ぶ感じです。


現在の状態として
A B C D E F G H I J K
9 赤 青 黄 備考(H~Kのセルを結合し、備考欄にしています)
10 赤 青 黄 備考
11 赤 青 黄 備考
12 赤 青 黄 備考
13 赤 青 黄 備考
:
:
:
23まで続きます。
黄色のみFGのセルを結合しています。

そこで以下のようなマクロをシートモジュールに組みましたが、


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Shp As Shape
Dim Rng As Range
Dim TgRng As Range
Dim Flg As Boolean
Set TgRng = Range("D9:FG" & Cells(Rows.Count, 1).End(xlUp).Row)
Set Rng = Intersect(TgRng, Target)
If Rng Is Nothing Then Exit Sub
Cancel = True
With Range(Cells(Rng.Row, 1), Cells(Rng.Row, 5))
For Each Shp In ActiveSheet.Shapes
If TypeName(Shp.DrawingObject) = "Oval" Then
If Not Intersect(.Cells, Shp.TopLeftCell) Is Nothing Then
If Not Intersect(Rng, Shp.TopLeftCell) Is Nothing Then Flg = True
Shp.Delete
End If
End If
Next
If Not Flg Then
With ActiveSheet.Shapes.AddShape(msoShapeOval, _
Rng.Left, Rng.Top, Rng.Width, Rng.Height)
.Fill.Visible = msoFalse
End With
End If
End With
Set Rng = Nothing
Set TgRng = Nothing
End Sub

F9G9を結合した黄の部分に丸はつくのですが、再びダブルクリックしても消えないようになっています。
また、H~Kの備考欄にも楕円形の丸がついてしまい消せない状態です。

赤を選択し、訂正で青を選択すると丸も赤から青へ自動に移ります。

黄色の部分を消せるようにするのと、備考欄は普通に文字が打てるようにするにはどのように改善していけばよいでしょうか??
皆様よろしくお願いします。
Yahoo!知恵袋 4012日前
コメントする
お気に入り
1
質問者が選んだベストソリューション
提示のマクロを自分なりに修正したところ、試した限りではそれっぽい動作にはなりました。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rng As Range, sh As Shape, Flg As Boolean
Set Rng = Target(1)
If Intersect(Rng, Me.Range("D9:F23")) Is Nothing Then Exit Sub
Cancel = True
With Me.Range(Me.Cells(Rng.Row, 4), Me.Cells(Rng.Row, 6))
For Each sh In Me.Shapes
If sh.AutoShapeType = msoShapeOval And _
Not Intersect(.Cells, sh.TopLeftCell) Is Nothing Then
If Not Intersect(Rng, sh.TopLeftCell) Is Nothing Then Flg = True
sh.Delete
End If
Next sh
End With
If Not Flg Then
With Rng.MergeArea
Me.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Fill.Visible = False
End With
End If
Set Rng = Nothing
End Sub


余計なお世話ですが、、、
オートシェイプは印刷で位置がずれたり、ファイルサイズが重くなったりで、あんまり良い印象がありません。背景色と文字色で選択を表現するなんて手法もありかと思います。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target(1), Me.Range("D9:F23")) Is Nothing Then Exit Sub
Cancel = True
With Me.Range(Me.Cells(Target(1).Row, 4), Me.Cells(Target(1).Row, 6))
.Interior.ColorIndex = xlColorIndexNone
.Font.ColorIndex = 16
End With
Target(1).MergeArea.Interior.ColorIndex = 11
Target(1).MergeArea.Font.ColorIndex = 2
End Sub
Yahoo!知恵袋 4012日前
シェア
 
コメントする
 

参考になったと評価
  このQ&Aは参考になりましたか?

Share (facebook)
その他の解決方法を知っていますか?
回答する
全般
47
Views
質問者が納得まぁ少なくても星撮れるくらいにならないと、 現地で応用出来ませんので、国内にいるうちに まともに星撮れるようになってください。 そうしないと、設定うんぬんは「現場の状況」でまったくかわります。 よって、答えられないw S95自分も持ってますが、さすがにマイナス25℃付近での動作は 確認してません。 マイナス8℃ほどなら星撮る時に動作してましたけどw まぁ記念写真程度の「撮影時間」であれば、 バッテリーもさほど気にしなくてもいいでしょう。 予備は必要ですけど。 短時間で撮影するんですから、短時間で「ピン...
3567日前view47
全般
72
Views
質問者が納得APNの設定が間違ってるだけかと思います。 ちゃんと設定してますか?
3573日前view72
全般
72
Views
質問者が納得メモリーは相性問題がつきまといます。ので、メモリーメーカー及びマザーボードメーカーの対応リストで確認する事が重要です。 また、0x0000000A及び0x0000007Fのエラーメッセージを検索しエラー原因をつかむことも大事です。
3686日前view72
全般
80
Views
質問者が納得sumifs 関数でどうですか!! http://www.becoolusers.com/excel/sumifs.html
3668日前view80
全般
57
Views
質問者が納得複数月をカウントすることができます。 次のようにすればよいでしょう。 仮に3ヶ月までの集計をするとしたらA1セル、B1セル、C1セルに対象とする月をそれぞれ入力します。 A4セルには次の式を入力してF4セルまでドラッグコピーします。 =IF($A1="",0,COUNTIF(INDIRECT($A1&"!$C$2:$C$1000"),A3))+IF($B1="",0,COUNTIF(INDIRECT($B1&"!$C$2...
3670日前view57

取扱説明書・マニュアル

1968view
http://www.nttdocomo.co.jp/.../F-12C_J_OP_All.pdf
147 ページ5.99 MB
もっと見る

関連製品のQ&A