VBA: ショートカット登録

Application.OnKey “{F2}”, “Sample1” ‘ショートカット登録
Application.OnKey “{F2}” ‘ショートカット解除
F1 HELP 〇
F2 EDIT
F3 Name Box 〇
F4 Repeat
F5 Jump
F6 Area Change 〇
F7 Spell check 〇
F8 Area Select 〇
F9 Re-Calc
F10 Menu Hint
F11 Auto graph 〇
F12 Save as 〇

マクロボタンの設置+実行マクロを登録


'マクロボタンの設置+実行マクロを登録
ActiveSheet.Buttons.Add(157.5, 21.75, 45.75, 21.75).Select
Selection.OnAction = "呼び出すマクロ名"
Selection.Characters.Text = "ボタンのタイトル"
With Selection.Characters(Start:=1, Length:=8).Font
.Name = "Meiryo UI"
.Size = 11
End With
Range("A1").Select

VBA: 数字からセルのX座標変換

Function NumToAbc(n As Integer) As String
’数字からセルのX座標変換 - AZZ(1378)列まで対応
If n < 27 Then
NumToAbc = Chr(64 + n)
Else
NumToAbc = Chr(64 + ((n - 1) \ 26)) & Chr(65 + ((n - 1) Mod 26))
End If
End Function

VBA: 条件付き書式_自動セット


Sub 条件付き書式_自動セット(a As Boolean)
	'シート「リスト」のC列の値と同じ値が見つかった場合、そのC列の背景色を条件式に登録する
	YY = 2
	CL = 0
	Columns("H:H").Select
	Do While Sheets("リスト").Cells(YY, 3) <> ""
		Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & Chr(34) & Sheets("リスト").Cells(YY, 3) & Chr(34)
		Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
		Selection.FormatConditions(1).Interior.Color = Sheets("リスト").Cells(YY, 3).Interior.Color
		Selection.FormatConditions(1).StopIfTrue = False
		'Exit Do
		YY = YY + 1
	Loop
End Sub

VBA:クリップボードの値貼り付け&コピー


Private Sub SetCB(ByVal str As String)
'クリップボードに文字列を格納
  With CreateObject("Forms.TextBox.1")
	.MultiLine = True
	.Text = str
	.SelStart = 0
	.SelLength = .TextLength
	.Copy
  End With
End Sub

Private Sub GetCB(ByRef str As String)
'クリップボードから文字列を取得
  With CreateObject("Forms.TextBox.1")
	.MultiLine = True
	If .CanPaste = True Then .Paste
	str = .Text
  End With
End Sub

VBA: セルコメント


'コメントを挿入前に既存分があれば保持して末尾に追加
If TypeName(Cells(i, X).Comment) = "Comment" Then
strTitle = Cells(i, X).Comment.Text &amp; vbCrLf &amp; strTitle
Cells(i, X).ClearComments
End If
Cells(i, X).AddComment strTitle
Cells(i, X).Comment.Shape.Width = 200

 

EXCEL: 一括シート名の取得

シート数が複数かつ、全てのシート名を取得したい場合、下記のマクロをイミディエイト画面にペースト&エンターすればOk

for i=1 to ActiveWorkbook.Sheets.Count:debug.Print Sheets(i).name:next

Excel: LENB(半角長さ)が機能しない場合の回避

自分のPC環境ではLENBが機能しない。
Excel環境(言語)設定が要因だと思うが、この為だけに変更したくない。
毎回プログラムを作るのも面倒。そこで1行だけのマクロを準備。
VBA(ALT+F11)起動後、イミディエイト画面(CTRL+G)を開いて下記をコピペ。
縦の開始、終了行をセット、結果をセットする列番号、対象の列の列名をセットして実行。

マクロなので取消が出来ないため、必ずファイル保存をしてから実行すること。
※何度か苦い思い出があるため、ここ重要!!

for i=2 to 10:cells(i,Range(“b1”).Column)=LenB(StrConv(cells(i,Range(“a1”).Column), vbFromUnicode)):next