[Excel VBA] コピーした文字列を改行ごとにテキストボックス化して張り付ける
2012年 11月 04日
コピーした文字列を、選択セル位置を基準に一行ごとにテキストボックス化して貼り付けるマクロ。
ひとつのテキストボックスや行ごとに 箇条書きで書き溜めたアイデアを、
グループ分けしたり、前後関係で並べてみたり、そんなのに使えそう。
というかそのために作ったんだが、そもそも考えがまとまらないこととは関係なかったわ。
Sub ClipBoardToTextBox()ここの下のほうにあるDataObjectを使うやり方を試したんだが、
' クリップボードの文字列を取得
s = CreateObject("htmlfile").parentwindow.clipboarddata.GetData("text")
If s = "" Then Exit Sub
' 表示更新を停止
Application.ScreenUpdating = False
' アクティブセルの座標を取得
x = ActiveCell.Left
y = ActiveCell.Top
' 改行ごとに格納
slst = Split(s, vbCrLf)
For i = 0 To UBound(slst): Do
If slst(i) = "" Then Exit Do
' テキストボックスを該当行に作成
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, x, y, 0#, 0#).Select
' テキストボックスに文字を反映
Selection.Characters.Text = slst(i)
' テキストボックスの装飾
Selection.ShapeRange(1).TextFrame.AutoSize = msoTrue
Selection.ShapeRange.Line.Visible = msoTrue
' Selection.ShapeRange.Line.Style = msoLineThinThin ' 縁取り線「=」
' Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
' テキストボックスの作成座標を更新
y = y + Selection.Height
Loop Until 1: Next
' 表示更新を再開
Application.ScreenUpdating = True
End Sub
Microsoft Forms 2.0 Object Libraryを参照設定するために、ユーザフォームを追加したり面倒。
クリップボードから文字列の取得する方法もわからんかった(Formatなんとかってエラーが出る)のであきらめた。