目安箱 IV

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

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

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

【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[未読]

【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

【65】Re:図形描画、Shapeの方のテキストボックス...
Excel  Jaka  - 04/8/11(水) 17:34 -

引用なし
パスワード
   >255文字以内であれば、ここで十分だと思います。
>[#5961]

すみません。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=5961;id=excel

【72】Re:図形描画、Shapeの方のテキストボックス...
Excel  ichinose  - 04/8/31(火) 8:08 -

引用なし
パスワード
   ▼Jaka さん:
こんにちは。

Jakaさん、すごいですね!!目安箱での活躍・・・。

私も一つだけ投稿・・・。

「図形描画のShapeの方のテキストボックスにセルの内容を反映させる方法」


'==================================
Sub samp()
  With Range("a2")
   .Offset(-1, 0).Value = "反映"
   Set txt = ActiveSheet.TextBoxes.Add(.Left, .Top, .Width, .Height)
   txt.Formula = "=" & .Offset(-1, 0).Address
   End With
End Sub


上記のコードは、アクティブシートのセルA2のサイズにテキストボックスを作成し、
セルA1の内容をテキストボックスに反映させるコードです。

このコードの実行後に、セルA1の変更でテキストボックスの内容も変更されます。
マクロを使用しなくても手動操作でも可能です。

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