Excel VBA質問箱 IV

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

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


37208 / 76738 ←次へ | 前へ→

【44703】Re:クリックしてコピー
回答  Kein  - 06/11/29(水) 14:41 -

引用なし
パスワード
   右クリックイベントは、コマンドボタンのクリックイベントに変更しました。
コントロールツールボックスのボタンをシート上に配置して、
シートモジュールの現在のコード全体を、以下のコードに差し替えて下さい。
そしていったん他のシートを開いてから、戻って下さい。
今度はボタンを押す前に、基点にしたいセルを一つ選択して下さい。
つまりアクティブセルを基点にする、ということになります。
>記録を終了し、再開する場合に記録された行の途中を基点に
>したら、行の最後から記録を始める
IV列から逆順に転記される、という意味ですか ? こちらではそのような
ことにはなりませんが・・。
>ステータスバーに状態表示が出るのはカッコいい
ボタンの表面の文字列も同じように変化するようにしたので、ステータスバー
は不要かも知れませんが、いちおう残しておきました。

Private MyR As Range

Private Sub Worksheet_Activate()
  Me.CommandButton1.Caption = "待機中"
  With Application
   .DisplayStatusBar = True
   .StatusBar = "●○● 待機中 ○●○"
  End With
End Sub

Private Sub Worksheet_Deactivate()
  Set MyR = Nothing
  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.Cells(1).Value
End Sub

Private Sub CommandButton1_Click()
  With ActiveCell
   If .Column > 200 Then Exit Sub
   If MyR Is Nothing Then
     If MsgBox(.Address(0, 0) & " を基点にしますか", 36) = 6 Then
      Set MyR = Range(.Cells(1), Cells(.Row, 256))
      CommandButton1.Caption = "記録中"
      Application.StatusBar = "☆☆☆ 記録中 ☆☆☆"
     End If
   Else
     If MsgBox("記録を終了しますか", 36) = 6 Then
      Set MyR = Nothing
      CommandButton1.Caption = "停止中"
      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 お礼

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