Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


59087 / 76732 ←次へ | 前へ→

【22358】Re:Selection.Characters.Text で改行入りの長文を入力
発言  ichinose  - 05/2/17(木) 1:27 -

引用なし
パスワード
   ▼あき さん:
こんばんは。

>以下のようなマクロで、
>オートシェイプ内にテキストを入力しようとしているのですが、
>どうしてもブランクになってしまします。
>
>Intext(String型)の文字数を減らすとうまくいくのですが、
>文字数が一定以上になるとブランクになります。
>
>理由がまったくわかりません。
>回避方法等あれば教えて頂きたいと思います。。
>
>  ActiveSheet.Shapes.AddShape(msoShapeRectangle, 154.5, 155.25, 300.25, 1000.25).Select
>  Selection.Characters.Text = Intext
普通に↑Textプロパティを使用すると、255を超えると駄目みたいですねえ!!

こんな風にすると表示できます。

'==========================================================
Sub test()
  Dim aaa As Shape
  Set aaa = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 154.5, 155.25, 300.25, 1000.25)
  aaa.TextFrame.Characters.Text = ""
  With aaa.TextFrame
   .Characters(1, 30).Text = String(30, "a")
   For idx = 2 To 20
    .Characters(31 * (idx - 1), 31).Insert vbLf & String(30, "a")
    Next
   MsgBox .Characters.Text
   MsgBox Len(.Characters.Text)
   End With
End Sub

例では、30文字毎に設定していますが、255までならOKです。
但し、Textプロパティを普通?に使うと、表示されたように255までしか表示できません。

中のテキストを取得するときも少しずつとる手法を使います。

'================================================================
Sub test3()
  Dim aaa As Shape
  Dim wk As String
  Dim idx As Long
  Dim txt As String
  On Error Resume Next
  Set aaa = ActiveSheet.Shapes(1)
  txt = ""
  idx = 1
  wk = aaa.TextFrame.Characters(Start:=idx, Length:=255).Text
  Do Until Err.Number <> 0
   txt = txt & wk
   idx = idx + 255
   wk = aaa.TextFrame.Characters(Start:=idx, Length:=255).Text
   Loop
  MsgBox txt
  MsgBox Len(txt)
  On Error GoTo 0
End Sub

以上です。

1 hits

【22355】Selection.Characters.Text で改行入りの長文を入力 あき 05/2/16(水) 22:26 質問
【22358】Re:Selection.Characters.Text で改行入り... ichinose 05/2/17(木) 1:27 発言
【22386】Re:Selection.Characters.Text で改行入り... あき 05/2/17(木) 15:16 お礼
【22359】Re:Selection.Characters.Text で改行入り... ichinose 05/2/17(木) 1:31 発言

59087 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free