Excel VBA質問箱 IV

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

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


69077 / 76734 ←次へ | 前へ→

【12177】Re:テキストボックスの作成
回答  ichinose  - 04/3/25(木) 19:43 -

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

>はじめまして。
>駆け出しのVBA初心者のrokiと申します。
>テキストボックスについて質問なのですが、
>図形描画ツールバーのテキストボックスの作成と同じ
>処理で線無しのものを作成するマクロの作成の仕方を
>どなたかご存知ありませんか。
>テキストボックスはマウスをドラッグして作画したいです。
>オートシェイプの規定値としては線ありでマクロ実行時
>のみ線無しのテキストボックスを作成したいのですが・・・
「セル範囲を選択してマクロを実行すると選択したセル範囲にテキストボックスを線無しで作成する」なら、
'===============================================
Sub samp1()
  Dim txt As Shape
  Dim rng As Range
  Set rng = Selection
  With rng
   Set txt = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, .Width, .Height)
   txt.Line.Visible = msoFalse
   End With
End Sub

でいいと思うのですが、roki さんが考えている事は違うのでしょうね!!

以下のマクロで何となく、それらしく動いています。

Thisworkbookのモジュールに

'================================================================
Private WithEvents cmd As CommandBarButton
Private click_flg As Long
'================================================================
Sub sample()
  With ActiveSheet
   cnt = .Shapes.Count
   click_flg = 0
   Set cmd = Application.CommandBars("Drawing").Controls(9)
   Application.CommandBars("Drawing").Controls(9).Execute
   Do Until (.Shapes.Count = cnt + 1) Or click_flg >= 2
     DoEvents
     Loop
   If .Shapes.Count = cnt + 1 Then
     .Shapes(.Shapes.Count).Line.Visible = msoflse
     End If
   End With
  Set cmd = Nothing
End Sub
'========================================================================
Private Sub cmd_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  click_flg = click_flg + 1
End Sub


「Thisworkbook.sample」を実行してみて下さい。

ただ、不安定なところもあります。
テキストボックス作成範囲を選択中は、コマンドバーのいくつかのコマンドボタンの
表示が非表示状態になってしまいます(実際にクリックすることはできますが)。


確認してみて下さい。

0 hits

【12175】テキストボックスの作成 roki 04/3/25(木) 18:34 質問
【12177】Re:テキストボックスの作成 ichinose 04/3/25(木) 19:43 回答
【12178】Re:テキストボックスの作成  追伸 ichinose 04/3/25(木) 19:47 発言
【12182】Re:テキストボックスの作成  別解 ichinose 04/3/25(木) 21:15 発言
【12194】Re:テキストボックスの作成 roki 04/3/26(金) 13:02 お礼
【14692】Re:テキストボックスの作成 チロ 04/6/4(金) 22:44 質問
【14696】Re:テキストボックスの作成 ichinose 04/6/5(土) 9:37 回答
【14697】Re:テキストボックスの作成 チロ 04/6/5(土) 10:38 お礼

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