選択したセルの情報をクリップボードに張り付けるエクセルマクロ

選択したセルの、ブック名、シート名、セルの位置とセル自体の値をクリップボードに設定するマクロ(getActiveCellValueCB1プロシージャ)

Sub getCurrentSheetNameCB()
  putCB getCurrentSheetName()
End Sub

Sub getActiveCellRowColCB()
  putCB getActiveCellRowCol()
End Sub

Sub getActiveCellValueCB1()
  putCB "ブック / シート / セル / 値 = " & _
    joindel(ActiveWorkbook.Name, getCurrentSheetName(), getActiveCellRowCol(), ActiveCell.Text)
End Sub

Sub getActiveCellValueCB2()
  putCB "シート / セル / 値 = " & _
    joindel(getCurrentSheetName(), getActiveCellRowCol(), ActiveCell.Text)
End Sub

Function getCurrentSheetName()
  Dim sheetName As String
  getCurrentSheetName = ActiveSheet.Name
End Function

Function getActiveCellRowCol()
  Dim r As Long
  r = Selection.Row
  Dim l As Long
  l = Selection.Column
  getActiveCellRowCol = ConvertToLetter(l) & CStr(r)
End Function

' join
Function joindel(ParamArray val() As Variant)
  joindel = Join(val, " / ")
End Function

' クリップボードに入れる
Private Sub putCB(ByVal val As String)
  With CreateObject("Forms.TextBox.1")
    .MultiLine = True
    .Text = val
    .SelStart = 0
    .SelLength = .TextLength
    .Copy
  End With
End Sub

' https://docs.microsoft.com/ja-jp/office/troubleshoot/excel/convert-excel-column-numbers
Function ConvertToLetter(iCol As Long) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function