|
図形描画、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
|
|