| 
    
     |  | 図形描画、Shapeの方のテキストボックスの書き込みと読み込み 
 255文字以内であれば、ここで十分だと思います。
 [#5961]
 
 256文字以上となると、こんな風にしないとダメですね。
 
 
 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
 
 
 Sub テキストからセルへ()
 Dim Myst As String, Myst1 As String
 Dim MCS As Long
 MCS = 1: Myst = Empty: Myst1 = Empty
 On Error Resume Next
 Do
 Myst1 = ActiveSheet.Shapes("Text Box 1").TextFrame.Characters(MCS, 255).Text
 If Err <> 0 Then Exit Do
 Myst = Myst & Myst1
 MCS = MCS + 255
 Loop Until Myst1 = ""
 Range("A1").Value = Myst
 End Sub
 
 
 Sub テキストからテキストへ()
 Dim Myst As String, MCS As Long
 Myst = Empty: MCS = 1
 On Error Resume Next
 Do
 Myst = ActiveSheet.Shapes("Text Box 1").TextFrame.Characters(MCS, 200).Text
 If Err <> 0 Then Exit Do
 ActiveSheet.Shapes("Text Box 2").TextFrame.Characters(MCS).Insert String:=Myst
 MCS = MCS + 200
 Loop Until Myst = ""
 End Sub
 
 
 あまり覚えていませんが、テキストボックスのクリアについて、文字数が多い場合クリア1だけだとクリアしきれないような事があったんで、文字数が多い場合は2の方を使った方がいいかも。
 
 クリア1
 ActiveSheet.Shapes("Text Box 1").TextFrame.Characters.Text = ""
 DoEvents
 
 クリア2
 Do Until ActiveSheet.Shapes("Text Box 2").TextFrame.Characters.Text = ""
 ActiveSheet.Shapes("Text Box 2").TextFrame.Characters.Text = ""
 DoEvents
 Loop
 
 --------------------------------
 シート上コントロールのテキストボックス場合
 
 シートモジュール
 
 テキストボックスへの書き込み(Sheet1!A1からの)
 Private Sub CommandButton1_Click()
 ActiveCell.Activate   '← 97用対策
 TextBox1.Value = Sheets("Sheet1").Range("A1").Value
 End Sub
 
 テキストボックスクリア
 Private Sub CommandButton2_Click()
 ActiveCell.Activate   '← 97用対策
 TextBox1.Value = ""
 End Sub
 
 
 標準モジュールからのクリア
 
 Sub シート上コントテキストクリア()
 Sheets("Sheet1").TextBox1.Value = ""
 End Sub
 
 |  |