文頭および文末の文字を削除するマクロ（ランチャー２）
2021年03月20日
前回、文頭および文末に文字を挿入するマクロを作った。
マクロの実行はCtrl＋Zで戻せないので、元に戻すためのマクロを作る。
今回もめんどくさいけど、ユーザーフォームで。
文頭と文末から削除する文字数を指定するフォームを用意。
フォームに入力可能な文字を数値に制限するため、キーコントロールを実施。
数値専用のテキストボックス｜ユーザーフォーム入門 (excel-ubara.com)
キーコントロールのソースを見たら簡単そうだったので実装。
（Case vbKeyUp、Case vbKeyDownで指定するだけ）
上下操作で数値を増減させるけど、キー入力に備えてデフォルトはブランクに。
数値型だとブランクの場合に計算エラーが出るので
バリアント型で変数を受けて、数値型の変数を別途定義して計算。
何文字削除したらどうなるか事前に知りたいよな。
サンプル表示用のラベルを用意し、selection(1)で削除対象の文字を表示。
キーコントロールの最後に表示制御を入れていたら、
直接数値入力時に更新されないバグが発生。
「_change」で別途指定が必要だったので修正。
ダウンロード
デフォルトから変更したプロパティは以下の通り。
オブジェクト名：strTrimForm（フォーム名）
Caption（表示名）：セルの両端の文字列を削除
オブジェクト名：stLen '文頭から削除する文字数
TabIndex（タブ遷移の順番）：1
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
TextBoxに数字のみ入力させる 【VBA在庫管理#33】 | オレグラミング (oregramming.com)
オブジェクト名：edLen '文末文字
TabIndex（タブ遷移の順番）：2
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
オブジェクト名：CommandButton1 ’キャンセルボタン
Accelerator（操作キー Alt + ...）：C
Cancel（ESCキー紐づけ）：True
TabIndex（タブ遷移の順番）：4
オブジェクト名：CommandButton2 '実行ボタン
Accelerator（操作キー Alt + ...）：T
TabIndex（タブ遷移の順番）：3
オブジェクト名：SampleLeft '文頭の削除対象文字サンプル表示
TabStop（タブ遷移の対象）：False
オブジェクト名：SampleRight '文末の削除対象文字サンプル表示
TabStop（タブ遷移の対象）：False
以下、ソース
マクロの実行はCtrl＋Zで戻せないので、元に戻すためのマクロを作る。
今回もめんどくさいけど、ユーザーフォームで。
文頭と文末から削除する文字数を指定するフォームを用意。
フォームに入力可能な文字を数値に制限するため、キーコントロールを実施。
数値専用のテキストボックス｜ユーザーフォーム入門 (excel-ubara.com)
KeyCode = 0とすると、キー入力を無視する。
Acceleratorで指定した文字やESCキーのキャンセルも
KeyCode = 0の条件に入っている場合は操作が効かないので注意。
数値入力めんどくさいから上下操作もできる面白いな。キーコントロールのソースを見たら簡単そうだったので実装。
（Case vbKeyUp、Case vbKeyDownで指定するだけ）
上下操作で数値を増減させるけど、キー入力に備えてデフォルトはブランクに。
数値型だとブランクの場合に計算エラーが出るので
バリアント型で変数を受けて、数値型の変数を別途定義して計算。
何文字削除したらどうなるか事前に知りたいよな。
サンプル表示用のラベルを用意し、selection(1)で削除対象の文字を表示。
キーコントロールの最後に表示制御を入れていたら、
直接数値入力時に更新されないバグが発生。
「_change」で別途指定が必要だったので修正。
ダウンロード
デフォルトから変更したプロパティは以下の通り。
オブジェクト名：strTrimForm（フォーム名）
Caption（表示名）：セルの両端の文字列を削除
オブジェクト名：stLen '文頭から削除する文字数
TabIndex（タブ遷移の順番）：1
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
TextBoxに数字のみ入力させる 【VBA在庫管理#33】 | オレグラミング (oregramming.com)
オブジェクト名：edLen '文末文字
TabIndex（タブ遷移の順番）：2
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
オブジェクト名：CommandButton1 ’キャンセルボタン
Accelerator（操作キー Alt + ...）：C
Cancel（ESCキー紐づけ）：True
TabIndex（タブ遷移の順番）：4
オブジェクト名：CommandButton2 '実行ボタン
Accelerator（操作キー Alt + ...）：T
TabIndex（タブ遷移の順番）：3
オブジェクト名：SampleLeft '文頭の削除対象文字サンプル表示
TabStop（タブ遷移の対象）：False
オブジェクト名：SampleRight '文末の削除対象文字サンプル表示
TabStop（タブ遷移の対象）：False
以下、ソース
Sub Show_strTrimForm()
'https://excel-ubara.com/excelvba3/EXCELFORM002.html
strTrimForm.Show vbModal '・・・ モーダル表示
'strAddForm.Show vbModeless '・・・ モードレス表示 シート操作可能
End Sub
Sub strTrimMain(stLen, edLen)
Dim r As Range
If stLen = "" Then stLen = 0
If edLen = "" Then edLen = 0
Dim strt As Long, lngth As Long
strt = Val(stLen) + 1
lngth = Val(stLen) + Val(edLen)
For Each r In Selection
If Left(r.Formula, 1) <> "=" Then
If Val(stLen) + Val(edLen) < Len(r) Then
r.Value = Mid(r.Value, strt, Len(r) - lngth)
End If
End If
Next r
End Sub
Private Sub stLen_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case vbKeyReturn, vbKeyBack, vbKeyDelete, vbKeyTab
Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5, vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9
Case vbKeyLeft, vbKeyRight
Case vbKeyUp
If stLen = "" Then
stLen = 1
Else
stLen.Value = stLen + 1
End If
Case vbKeyDown
If stLen <> "" And stLen <> 0 Then
stLen.Value = stLen - 1
End If
KeyCode = 0
Case vbKeyEscape
Case Else
KeyCode = 0
End Select
End Sub
Private Sub stLen_change()
If Left(Selection(1).Formula, 1) <> "=" Then
SampleLeft.Caption = Left(Selection(1).Value, Val(stLen.Value))
End If
End Sub
Private Sub edLen_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case vbKeyReturn, vbKeyBack, vbKeyDelete, vbKeyTab
Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5, vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9
Case vbKeyLeft, vbKeyRight
Case vbKeyUp
If edLen = "" Then
edLen = 1
Else
edLen.Value = edLen + 1
End If
Case vbKeyDown
If edLen <> "" And edLen <> 0 Then
edLen.Value = edLen - 1
End If
KeyCode = 0
Case vbKeyEscape
Case Else
KeyCode = 0
End Select
End Sub
Private Sub edLen_change()
If Left(Selection(1).Formula, 1) <> "=" And edLen <> "" Then
SampleRight.Caption = Right(Selection(1).Value, edLen.Value)
End If
End Sub
Private Sub CommandButton1_Click() 'キャンセルボタン
'https://excel-ubara.com/excelvba3/EXCELFORM003.html
Unload Me
End Sub
Private Sub CommandButton2_Click() '実行ボタン
Call strTrimMain(stLen, edLen)
Unload Me
End Sub
PR
Comment