Excel VBA質問箱 IV

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

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


37221 / 76738 ←次へ | 前へ→

【44690】Re:クリックしてコピー
回答  Kein  - 06/11/29(水) 0:55 -

引用なし
パスワード
   例えばこんな感じで、どうでしょーか ?
ボタンを押す代わりに、右クリックイベントで 200列以内 の任意のセルを
右クリックしたとき、記録と停止を問い合わせてから切り替えます。
転記はダブルクリックにて行います(シングルクリックイベントが無いので)。
状態の表示には、ステータスバーを使います。
以下の全てのコードをシートモジュールの先頭から入れて、いったん他の
シートを開いてから戻って下さい。初めに「待機中」と表示します。

Private MyR As Range

Private Sub Worksheet_Activate()
  Set MyR = Nothing
  With Application
   .DisplayStatusBar = True
   .StatusBar = "●●● 待機中 ●●●"
  End With
End Sub

Private Sub Worksheet_Deactivate()
  With Application
   .StatusBar = False
   .DisplayStatusBar = False
  End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim Cnt As Integer
 
  If MyR Is Nothing Then Exit Sub
  Cnt = WorksheetFunction.CountA(MyR)
  If Cnt = MyR.Count Then
   MsgBox "これ以上、値の転記をすることはできません", 48
   Exit Sub
  End If
  Cancel = True
  MyR.Cells(Cnt + 1).Value = Target.Value
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
  With Target
   If .Cells(1).Column > 200 Then Exit Sub
   Cancel = True
   If MyR Is Nothing Then
     If MsgBox(.Address(0, 0) & " を基点にしますか", 36) = 6 Then
      Set MyR = Range(.Cells(1), Cells(.Row, 256))
      Application.StatusBar = "☆☆☆ 記録中 ☆☆☆"
     End If
   Else
     If MsgBox("記録を終了しますか", 36) = 6 Then
      Set MyR = Nothing
      Application.StatusBar = "★★★ 停止中 ★★★"
     End If
   End If
  End With
End Sub

0 hits

【44689】クリックしてコピー 悩みすぎ 06/11/29(水) 0:11 質問
【44690】Re:クリックしてコピー Kein 06/11/29(水) 0:55 回答
【44691】Re:クリックしてコピー Kein 06/11/29(水) 1:00 発言
【44692】Re:クリックしてコピー Kein 06/11/29(水) 1:12 発言
【44695】Re:クリックしてコピー 悩みすぎ 06/11/29(水) 11:38 質問
【44703】Re:クリックしてコピー Kein 06/11/29(水) 14:41 回答
【44704】Re:クリックしてコピー 悩みすぎ 06/11/29(水) 15:29 質問
【44711】Re:クリックしてコピー Kein 06/11/29(水) 17:29 発言
【44716】Re:クリックしてコピー 悩みすぎ 06/11/29(水) 18:52 お礼

37221 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free