順次セル選択して文字列変換してCBに格納

概要

• UI都合で改行を含む文字列の編集が難しいアプリケーションを使う際の効率化マクロ。
• Excelを下書きとして使ったり、既存の文書があってそれをコピペしたい時に使う。
• アプリケーション独自の改行コードがある場合、それに合わせて改行コードを変換してCBに格納できる。
• ペーストはCtrl+Vでも良いが1つずつウインドウを往復するのが面倒なのでWin+Vがおすすめ。

使い方

1. InputBoxが出てくるのでセルを選択し実行
2. Win+VでCBに格納された変換後の文字列を順に貼り付ける

コード

Option Explicit
  '適宜変更
    Const 変換対象文字 As String = vbLf
    Const 変換文字 As String = "\"
    Const 待ち時間 = 300 'ミリ秒
    

Sub 順次セル選択して文字列変換してCB格納()
    Const 分母 = 86400000 '待ち時間のミリ秒変換分母

  'InputBox用の説明文
    Dim Cmt(8)
    Cmt(0) = "「" & 変換対象文字 & "」を「" & 変換文字 & "」に変換してクリップボードに格納します。"
    Cmt(1) = ""
    Cmt(2) = "セルを選択してください。"
    Cmt(3) = "（Ctrlで複数選択可能。ドラッグで範囲選択可能）"
    Cmt(4) = ""
    Cmt(5) = "実行後、Win+Vで順番にペーストできます。"
    Cmt(6) = ""
    Cmt(7) = "※待ち時間が短いとクリップボードに格納できない場合があります。"
    Cmt(8) = "  その際はVBEから待ち時間を調整してください。"
    Dim Prompt: Prompt = Join(Cmt, vbCrLf)
    Const Title = "順次セル選択→文字列変換→クリップボードに格納"
  
  
  'メイン
    On Error GoTo Err
    Dim rng As Range
    Set rng = Application.InputBox(Prompt, Title, Type:=8)
    rng.Select
  
  'いったん配列に格納
    ReDim Arr(rng.Cells.Count - 1)
    Dim c As Range, i As Long
    For Each c In rng.Cells
      Arr(i) = c.Value
      i = i + 1
    Next
    
  '仕上げ：CBに格納
    Dim ub
    ub = UBound(Arr)
    For i = ub To 0 Step -1 'CB順を選択順にするため逆順でループ
      Call CB格納(Arr(i), 変換対象文字, 変換文字)
      Application.Wait [Now()] + 待ち時間 / 分母
    Next
      
Exit Sub
Err:
  Select Case Err.Number
    Case 424
      Err.Clear
  End Select
End Sub

Private Sub CB格納(Target, 変換対象文字, 変換文字)
  Dim buf
  buf = Replace(Target, 変換対象文字, 変換文字)
  
  With New MSForms.DataObject
    .SetText buf      '変数の値をDataObjectに格納する
    .PutInClipboard   'DataObjectのデータをクリップボードに格納する
  End With

End Sub