目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
223 / 277 ←次へ | 前へ→

【63】図形描画、Shapeの方のテキストボックスの書き込みと読み込み
Excel  Jaka  - 04/8/11(水) 16:30 -

引用なし
パスワード
   図形描画、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

5,249 hits

【63】図形描画、Shapeの方のテキストボックスの書き込みと読み込み Jaka 04/8/11(水) 16:30 Excel[未読]
【65】Re:図形描画、Shapeの方のテキストボックスの... Jaka 04/8/11(水) 17:34 Excel[未読]
【72】Re:図形描画、Shapeの方のテキストボックスの... ichinose 04/8/31(火) 8:08 Excel[未読]

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
223 / 277 ←次へ | 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free