Results of 1 - 1 of about 37686 for IF (0.008 sec.)
- [[20101213213341]]
- #score: 1591
- @digest: f513e8589c1498a3f91c14c2b3540219
- @id: 52526
- @mdate: 2010-12-14T11:33:54Z
- @size: 10537
- @type: text/plain
- #keywords: nextcode (60898), ovals (30436), mysp (29986), myhh (12758), myww (12602), msoshapeoval (10875), myad1 (8958), myad2 (8558), beforerightclick (8492), ・" (8149), topleftcell (7976), mergearea (7632), height (7431), addshape (6621), width (5961), target (5692), msofalse (5685), cancel (5662), shapes (4401), integer (3026), address (2953), boolean (2756), intersect (2421), visible (2262), pictures (2150), nothing (1612), 画像 (1514), ロシ (1367), シェ (1354), トシ (1307), ェイ (1275), イベ (1236)
- 『二つのクリックイベントを一つのシートで行いたい』（Msd）
[エクセルのバージョン]Excel2003 [OSのバージョンの例]Windows 7 一つは選択したセルをオートシェイプで囲うコードでもう一つは画像挿入のコードなのですがこれを一つのシートに書くにはどのようにすればいいのでしょうか? 色々試してみて別々では正常に動くのですが二つ入れる事が出来ません コードは↓ Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim sp As Integer, i As Integer, R As Range, B As Boolean For Each R In Target If Not Intersect(R, Range("L10:AE12,L26:AE28")) Is Nothing Then If R.Value = "・" Or R.Value = "" Then GoTo NEXTCODE Cancel = True B = False For i = 1 To Me.Ovals.Count If Shapes(i).TopLeftCell.Address = R.Address Then B = True: Exit For Next i If B Then Ovals(i).Delete Else Set R = R.MergeArea With Me.Shapes.AddShape(Type:=msoShapeOval, _ Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height) .Fill.Visible = msoFalse End With End If End If NEXTCODE: Exit Sub Next R End Sub ↑これと、↓ Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim sp As Integer, i As Integer If Intersect(Target, Range("B1:K336")) Is Nothing Then Exit Sub With Target Cancel = True myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next Set mySP = ActiveSheet.Pictures.Insert(myF) myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If Set mySP = Nothing End With End Sub ↑です。 色々調べてみたのですが解りませんでした＞＜ どうか御教授ねがいます。 ---- 一つのプロシージャにすることもできますが、こんな感じでできると思います。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) BRC1 Target BRC2 Target End Sub Private Sub BRC1(ByVal Target As Range) Dim sp As Integer, i As Integer, R As Range, B As Boolean For Each R In Target If Not Intersect(R, Range("L10:AE12,L26:AE28")) Is Nothing Then If R.Value = "・" Or R.Value = "" Then GoTo NEXTCODE Cancel = True B = False For i = 1 To Me.Ovals.Count If Shapes(i).TopLeftCell.Address = R.Address Then B = True: Exit For Next i If B Then Ovals(i).Delete Else Set R = R.MergeArea With Me.Shapes.AddShape(Type:=msoShapeOval, _ Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height) .Fill.Visible = msoFalse End With End If End If NEXTCODE: Exit Sub Next R End Sub Private Sub BRC2(ByVal Target As Range) Dim sp As Integer, i As Integer If Intersect(Target, Range("B1:K336")) Is Nothing Then Exit Sub With Target Cancel = True myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next Set mySP = ActiveSheet.Pictures.Insert(myF) myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If Set mySP = Nothing End With End Sub (Mook) ---- （Msd） Mookさん答えていただきありがとうございます。 掲示していただいたコードで出来たのですが幾つか問題が出てしまいました＞＜; 以前のコードではCancel = Trueでメニュー（コンテキストメニュー?）が出ない様になっていたのですがなぜかメニューが出てしまいます^^; Cancel = Trueもちゃんと書かれているのになぜなんでしょう? それとこれは掲示していただいたコード以前からなのですが、はじめのオートシェイプで選択セルをまるく囲うコードは他のシートでも使っているのですがそっちではちゃんと思ったとおり（クリックでまるく囲って、まるく囲ってあるセルをクリックすると丸が消せる）に動いてくれるのですがこっちのシートではオートシェイプで選択セルをまるく囲う事は出来るのですがもう一度クリックすると丸が消せずにまたまるく囲ってしまいます。又、色々クリックしていると突然違うセルの丸が消えたりもします。 多分コード自体で違うところはRange位だと思うのですが。。。思った通りに動いてくれるシートは Range("K13:AH48")で変な動きをしてしまうコードはRange("L10:AE12,L26:AE28")でその位しか違いはないと思うのですが。。。 原因不明でネットで調べようと思ったのですが調べようがありませんでした＞＜ NEXTCODE:は関係ないかと思い書きませんが一応コードも載せさせていただきます 思ったとおりに動いてくれるシートのコード↓ Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim sp As Integer, i As Integer, R As Range, B As Boolean For Each R In Target If Not Intersect(R, Range("K13:AH48")) Is Nothing Then If R.Value = "・" Or R.Value = "" Then GoTo NEXTCODE Cancel = True B = False For i = 1 To Me.Ovals.Count If Shapes(i).TopLeftCell.Address = R.Address Then B = True: Exit For Next i If B Then Ovals(i).Delete Else Set R = R.MergeArea With Me.Shapes.AddShape(Type:=msoShapeOval, _ Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height) .Fill.Visible = msoFalse End With End If End If NEXTCODE: ・ ・ 変な動きをしてしまうシートのコード↓ Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim sp As Integer, i As Integer, R As Range, B As Boolean For Each R In Target If Not Intersect(R, Range("L10:AE12,L26:AE28")) Is Nothing Then If R.Value = "・" Or R.Value = "" Then GoTo NEXTCODE Cancel = True B = False For i = 1 To Me.Ovals.Count If Shapes(i).TopLeftCell.Address = R.Address Then B = True: Exit For Next i If B Then Ovals(i).Delete Else Set R = R.MergeArea With Me.Shapes.AddShape(Type:=msoShapeOval, _ Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height) .Fill.Visible = msoFalse End With End If End If NEXTCODE: ・ ・ ↑これです。 原因のわかる方御教授願います<m(__)m> n ---- 変な動き の方は良く分かりませんが・・・ Cancel=True は Worksheet_BeforeRightClick イベントプロシージャ内に書かないと意味がありません。 イベント内でTargetの範囲を判断してからCancelとサブプロシージャをCallするように してみてはどうでしょうか? あとは、このような使い方には違和感がありますね。 別のRange型の変数を使うかWithステートメントで良いのでは? For Each R In Target Set R = R.MergeArea Next R （momo） ---- momoさん ご回答いただきありがとうございます。 イベントプロシージャ内にTargetの範囲を書き込ませていただいてCancel=Trueは無事にきくようになりました。 ありがとうございます。 御指摘いただいた所は以前Targetの範囲内にある"・"だけのセルと空白""セルを除外するには（まるで囲わない）様にするのに Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim sp As Integer, i As Integer If Not Intersect(Target, Range("K13:AH48")) Is Nothing Then If Target.Value = "・" Then Exit Sub Else If Target.Value = "" Then Exit Sub Else With Target For i = 1 To Me.Ovals.Count If Me.Shapes(i).TopLeftCell.Address = .Cells(1, 1).Address Then: sp = i Next i Cancel = True If sp Then Ovals(sp).Delete Else Me.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End If End With End If End If End If If Target.Count <> 1 Then Exit Sub If Intersect(Target, Range("B14:C115")) Is Nothing Then Exit Sub Cancel = True If Target.Value = "□" Then Target.Value = "■" Else If Target.Value = "■" Then Target.Value = "□" Else Exit Sub End If End If End Sub とコードを書いた所型が一致しませんとエラーになってしまい行き詰ってしまった時にネットで質問させていただいたら、 セル範囲であるTargetに対して単一の値である"・"や、""等に対して問い合わせをしているのでエラーとなってしまうので、Taget範囲に対して単一セルでループ(For Each R In Targetで）を掛けてあげれば、エラーは回避できると教えていただきこの様な形になったのですがもっと他の回避方法の方が良かったでしょうか? 何分初心者なのでもっとコードが見やすく出来ればと思っているのですが。。。 （Msd） ---- 変な動きの原因がわかりました。 シート内にテキストがあった事が原因だったみたいです。 Ovals限定でCountしているのに、Shapesをループしているので画像や図形があるとおかしな動きをしてしまっていたみたいです。 お騒がせしました。 また見ていただき考えてくれた方にも感謝いたします。 （Msd）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201012/20101213213341.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97046 documents and 608224 words.
訪問者：