|
参考になれば...。
Sub セルからテキストへ()
Dim Celst1 As String, Celst2 As String
ActiveSheet.Shapes("Text Box 1").TextFrame.Characters.Text = ""
DoEvents
Celst1 = Range("A1").Value
Celst2 = Empty
For i = 1 To Len(Range("A1").Value)
Celst2 = Celst2 & Mid(Celst1, 1, 1)
Celst1 = Mid(Celst1, 2)
Ct = Ct + 1
If i Mod 200 = 0 Then
ActiveSheet.Shapes("Text Box 1").TextFrame.Characters(i - 200 + 1).Insert String:=Celst2
Celst2 = Empty
End If
Next
If Celst2 <> Empty Then
ActiveSheet.Shapes("Text Box 1").TextFrame.Characters(Ct + 1).Insert String:=Celst2
End If
End Sub
|
|