| |
概要
テキストボックスの右クリックメニューで、コピペ、切り取り、改行ができるようになります。
テキストボックス上のEnterキーで、改行ができるようになります。
SendKeysで処理しているせいか、安定しているとは言いにくいです。
また、PCスペックによっても変わってくると思います。
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ユーザーフォーム上に
テキストボックスと、その下に
コマンドボタンの計２つのコントロールがあるとして。
SendKeys "{UP}" で、フォーカスが戻るように配置。
TextBoxのプロパティで、MultiLine、WordWrapが、Trueに設定する。
テキストボックス名 = TextBox1
コマンドボタン名 = CommandButton1
フォーム名は、適当に変えてください。
UserForm3で、作ったもので..。
//////////////////////////////////////////////////////////
フォームモジュール
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn And Shift = 0 Then
SendKeys "{UP}"
TextBox1.SetFocus
SendKeys "^({ENTER})"
End If
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With Application.CommandBars.Add(Position:=msoBarPopup, temporary:=True)
With .Controls.Add(Type:=msoControlButton)
.Caption = "切取り"
.FaceId = 21
.OnAction = "切取り_Fm3"
End With
With .Controls.Add _
(Type:=msoControlButton, temporary:=True)
.Caption = "コピー"
.FaceId = 19
.OnAction = "コピー_Fm3"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "貼り付け"
.FaceId = 22
.OnAction = "貼り付け_Fm3"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "改行"
.FaceId = 405
.OnAction = "改行_Fm3"
End With
.ShowPopup
'.Delete
End With
End If
'DoEvents
End Sub
------------------------------
標準モジュール
Sub 切取り_Fm3()
UserForm3.TextBox1.SetFocus
SendKeys "^x"
DoEvents
End Sub
Sub コピー_Fm3()
UserForm3.TextBox1.SetFocus
SendKeys "^c"
DoEvents
End Sub
Sub 貼り付け_Fm3()
UserForm3.TextBox1.SetFocus
SendKeys "^v"
DoEvents
End Sub
Sub 改行_Fm3()
UserForm3.TextBox1.SetFocus
SendKeys "^({ENTER})"
DoEvents
End Sub
/////////////////////////////////////////////////////////////////////
こちらは、シート上コントロールTextBoxの右クリックメニュー。
フラグ使って試行錯誤してたやつ。
標準モジュール
Public KGFlg As Boolean
Sub Sh切取り()
SendKeys "^x"
End Sub
Sub Shコピー()
SendKeys "^c"
End Sub
Sub Sh貼り付け()
SendKeys "^v"
End Sub
Sub Sh改行()
KGFlg = True
SendKeys "^({ENTER})"
End Sub
------------------------------
テキストボックスのあるシートモジュール
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With Application.CommandBars.Add(Position:=msoBarPopup, temporary:=True)
With .Controls.Add(Type:=msoControlButton)
.Caption = "切取り"
.FaceId = 21
.OnAction = "Sh切取り"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "コピー"
.FaceId = 19
.OnAction = "Shコピー"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "貼り付け"
.FaceId = 22
.OnAction = "Sh貼り付け"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "改行"
.FaceId = 405
.OnAction = "Sh改行"
End With
.ShowPopup
End With
End If
DoEvents
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If KGFlg = False Then
Sh改行
KGFlg = True
Else
KGFlg = False
End If
End If
End Sub
//////////////////////////////////////////////////////////////////////
フォーム上テキストボックスのEnterKeyによる改行だけ。
フォームモジュール
Private Sub CommandButton1_Click()
Unload Me
End
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn And Shift = 0 Then
DoEvents
TextBox1.SetFocus
SendKeys "^({ENTER})"
DoEvents
SendKeys "{UP}"
End If
End Sub
|
|
Jaka
- 04/7/26(月) 17:14 -
![[未読]](./data/FAQ/image/read_icon.gif){kind=icon}
≪
