投稿者「admin」のアーカイブ

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: Wクリック時にセルの値をクリップボードへ

投稿日時: 投稿者: 

'Wクリック時にセルの値をクリップボードへ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
	Dim moji As String
	If Target.Value <> "ここをWクリック" Then
		Application.StatusBar = "コピーセル対象外"
	Else
		moji = Cells(Target.Row, Target.Column + 7)
		Application.StatusBar = "Copy: " & moji
		CreateObject("WScript.Shell").Exec("clip").StdIn.Write moji
	End If
	Cancel = True
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