Ｐａｇｅ 784 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼ユーザーフォームの表示位置 自己満足 03/2/19(水) 19:08 ┗Re:ユーザーフォームの表示位置 ｂｙｋｉｎ 03/2/23(日) 12:11 ┗おお... 自己満足 03/2/24(月) 12:57 ─────────────────────────────────────── ■題名 ： ユーザーフォームの表示位置 ■名前 ： 自己満足 ■日付 ： 03/2/19(水) 19:08 -------------------------------------------------------------------------
| こんにちは。 どこかで見たような題名ですが過去ログとはちょっと違うので悩んでいます。お助けください。 セルをクリックしたその位置にユーザーフォームを表示したいのです。 （マウスカーソルを追って来るような感じ） Itemを登録したコンボボックスとOKボタンだけが有るセルと同じくらいの大きさのユーザーフォーム UF1 を作って以下で試してみましたが．．． 1．Cells(Target.Row, Target.Column).Topの後にプラスマイナスの補正を行うとそれらしく追って来てくれるのですが、スクロールさせてクリックすると画面外に表示されるようです。 2．.TOP=の値は1行目のセルからの距離?のようで値が100から550（ポイント?）の範囲外になると画面外に出るようです。取得した値を引いたり割ったりして補正してみたのですが画面内に表示する事は出来てもカーソルを追ってくれません。 マウスカーソル位置を取得出来れば良いのでしょうが、ピタッ！と追ってくるように出来ないものでしょうか。（当然、クリックした時だけUF1を表示させたい） ちなみに、セル高さは19.5（ポイント?）で画面上では50行から78．5行まで見えます。 （50行より上方は非表示やウインドウ枠の固定で見えなくなっています） Private Sub Worksheet_SelectionChange(ByVal Target As Range) With UF1 If Target.Count < 2 Then If Target.Row >= 59 Then .Top = Cells(Target.Row, Target.Column).Top .Left = Cells(Target.Row, Target.Column). Left .Show 0 Else .Hide End If End If End With End Sub |
| こんにちわ。もう見てへんかな？ >セルをクリックしたその位置にユーザーフォームを表示したいのです。 クリックってのは右クリックでええのかな？ ウィンドウ枠の固定をやってへんかったら Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Load UserForm1 With Application UserForm1.Left = ActiveCell.Left + .Width - .UsableWidth + .Left + ActiveWindow.Left UserForm1.Top = ActiveCell.Top + .Height - .UsableHeight + .Top + ActiveWindow.Top End With UserForm1.Show Unload UserForm1 Set UserForm1 = Nothing End Sub これで、ほぼアクティブセルに近いとこに表示されると思うねんけど、 ウィンドウ枠を固定してまうとちょっと難しいみたいやね。 で、↓こんな感じでどうでっしゃろか？ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Const OffsetX = 0 Const OffsetY = 0 Dim LastPaneFirstCell As Range Dim VisibleLeft As Single Dim VisibleTop As Single Dim TargetLeft As Single Dim TargetTop As Single Dim TargetPane As Integer Dim i As Integer Cancel = True If Target.Cells.Count > 1 Then MsgBox "複数セル選択時は右クリックできません", vbCritical Exit Sub End If With ActiveWindow For i = 1 To .Panes.Count With .Panes(i) If Not Intersect(Target, .VisibleRange) Is Nothing Then With .VisibleRange.Item(1) VisibleLeft = .Left VisibleTop = .Top End With TargetPane = i Exit For End If End With Next TargetLeft = Target.Left TargetTop = Target.Top Select Case .Panes.Count Case 2 With .Panes(1).VisibleRange If ActiveWindow.Panes(2).VisibleRange.Item(1).Row = 1 Then Set LastPaneFirstCell = .Cells(1, .Columns.Count).Offset(0, 1) Else Set LastPaneFirstCell = .Cells(.Rows.Count, 1).Offset(1, 0) End If End With If TargetPane = 2 Then TargetLeft = TargetLeft + LastPaneFirstCell.Left - VisibleLeft TargetTop = TargetTop + LastPaneFirstCell.Top - VisibleTop End If Case 4 With .Panes(1).VisibleRange Set LastPaneFirstCell = .Item(.Cells.Count).Offset(1, 1) End With If TargetPane = 2 Or TargetPane = 4 Then TargetLeft = TargetLeft + LastPaneFirstCell.Left - VisibleLeft End If If TargetPane = 3 Or TargetPane = 4 Then TargetTop = TargetTop + LastPaneFirstCell.Top - VisibleTop End If End Select End With Load UserForm1 With Application TargetLeft = TargetLeft + .Width - .UsableWidth + .Left + ActiveWindow.Left + OffsetX TargetLeft = .WorksheetFunction.Min(TargetLeft, .Left + .Width - UserForm1.Width) TargetTop = TargetTop + .Height - .UsableHeight + .Top + ActiveWindow.Top + OffsetY TargetTop = .WorksheetFunction.Min(TargetTop, .Top + .Height - UserForm1.Height) End With With UserForm1 .Left = TargetLeft .Top = TargetTop .Show End With Unload UserForm1 Set UserForm1 = Nothing End Sub 一応端っこのセルで右クリックした時にフォームが画面からはみ出ないようにしてます。 表示位置の微調整は OffsetX OffsetY の定数でやってください。 試してみてな。 ほな。 |
| ｂｙｋｉｎ さん、こんにちは。 ご回答ありがとうございます。 （神は見捨てていなかった。涙涙） 朝から一生懸命TESTしていましたので遅れちゃいましてすみません。 !!出来ました。!! Panes...?なんのこっちゃ。 で意味不明でも出来ちゃう所がすごいです。 >ウィンドウ枠の固定をやってへんかったら ...の方は なんだか下の方のセルになると画面外に出ているみたいで、少し解読が必要のようです。 ほんと助かりました、ありがとうございます。 <<< このマクロを試してみようとお考えの方に >>> 1,ユーザーフォームのStartUpPositionプロパティーを「0-手動」にする事。 2,ユーザーフォームの高さはできるだけ低く作成する事。 3,もしユーザーフォームが画面外に表示されてしまい シートへカーソルが戻らなくなったら Alt+f4 を押してユーザーフォームを消してください。 以上3点に注意してください。 TEST時にこれで ??? におちいってしまいました。 |