|
つんさん こんにちは。
おじゃまします。
ここにつけさせてね!
Shapesの方のテキストボックスだったら
[#5961]の応用とか、
更に256文字以上に対応させたいんだったら、
(Sheet1にあるテキストボックス1の内容をSheet2、C1に書きこみ。)
Sub テキストからセルへ()
Dim Myst As String, Myst1 As String, Myst2 As String, Myst3 As String
Dim Myst4 As String
Dim MCS As Long
MCS = 1: Myst = Empty: Myst1 = Empty
On Error Resume Next
Do
Myst1 = Sheets("Sheet1").Shapes("Text Box 1").TextFrame.Characters(MCS, 255).Text
If Err <> 0 Then Exit Do
Myst = Myst & Myst1
MCS = MCS + 255
Loop Until Myst1 = ""
Sheets("Sheet2").Range("C1").Value = Myst
End Sub
|
|