Excel VBA質問箱 IV

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

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


11693 / 13645 ツリー ←次へ | 前へ→

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

【12175】テキストボックスの作成
質問  roki  - 04/3/25(木) 18:34 -

引用なし
パスワード
   はじめまして。
駆け出しのVBA初心者のrokiと申します。
テキストボックスについて質問なのですが、
図形描画ツールバーのテキストボックスの作成と同じ
処理で線無しのものを作成するマクロの作成の仕方を
どなたかご存知ありませんか。
テキストボックスはマウスをドラッグして作画したいです。
オートシェイプの規定値としては線ありでマクロ実行時
のみ線無しのテキストボックスを作成したいのですが・・・

【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」を実行してみて下さい。

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


確認してみて下さい。

【12178】Re:テキストボックスの作成  追伸
発言  ichinose  - 04/3/25(木) 19:47 -

引用なし
パスワード
   Excel2000で確認しています。
バージョンが違うと駄目かも・・・。

【12182】Re:テキストボックスの作成  別解
発言  ichinose  - 04/3/25(木) 21:15 -

引用なし
パスワード
   こんな方法もありました。
但し、両方マクロになってしまいますが・・・。
'======================================================
Sub 線なしTextbox()
  Dim shp As Shape
  Set shp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 10, 10)
  With shp
   .Line.Visible = msoFalse
   .SetShapesDefaultProperties
   .Delete
   End With
  Application.CommandBars("Drawing").Controls(9).Execute
  
End Sub
==========================================================================
Sub 線ありTextbox()
  Dim shp As Shape
  Set shp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 10, 10)
  With shp
   .Line.Visible = msoTrue
   .SetShapesDefaultProperties
   .Delete
   End With
  Application.CommandBars("Drawing").Controls(9).Execute
End Sub

【12194】Re:テキストボックスの作成
お礼  roki  - 04/3/26(金) 13:02 -

引用なし
パスワード
   ▼ichinose さん:
返信ありがとうございます

>以下のマクロで何となく、それらしく動いています。
>
>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」を実行してみて下さい。
>
>ただ、不安定なところもあります。
>テキストボックス作成範囲を選択中は、コマンドバーのいくつかのコマンドボタンの
>表示が非表示状態になってしまいます(実際にクリックすることはできますが)。
>
>
>確認してみて下さい。

教えていただいたものを一通り試してみてこのプログラムを使うことに
しました。
ありがとうございました!!

【14692】Re:テキストボックスの作成
質問  チロ E-MAIL  - 04/6/4(金) 22:44 -

引用なし
パスワード
   はじめまして、チロと申します。

ファイル名をテキストボックスに表示させるマクロを考えています。とりあえず、ファイル名の取得はできたのですが、テキストボックスに表示させる方法が解りません。
テキストボックスに表示させ、尚且つ自動サイズ調整のできるマクロを教えていただきたいのですが・・・
テキストボックスの貼付け位置はアクティブセルです。よろしくお願いします。

【14696】Re:テキストボックスの作成
回答  ichinose  - 04/6/5(土) 9:37 -

引用なし
パスワード
   ▼チロ さん:
おはようございます。

>はじめまして、チロと申します。
>
>ファイル名をテキストボックスに表示させるマクロを考えています。とりあえず、ファイル名の取得はできたのですが、テキストボックスに表示させる方法が解りません。
>テキストボックスに表示させ、尚且つ自動サイズ調整のできるマクロを教えていただきたいのですが・・・
>テキストボックスの貼付け位置はアクティブセルです。よろしくお願いします。
こんな方法では どうでしょうか?
'===========================================================
Sub samp1()
  Dim txt As Shape
  Dim rng As Range
  Set rng = ActiveCell
  With rng
   .Value = ThisWorkbook.FullName '最初にセルにファイル名を設定
   .EntireRow.AutoFit
   .EntireColumn.AutoFit
   Set txt = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, .Width, .Height)
   txt.Line.Visible = msoTrue
   txt.TextFrame.Characters.Text = .Value
   .Value = ""
   End With
End Sub


確認してみて下さい。

【14697】Re:テキストボックスの作成
お礼  チロ  - 04/6/5(土) 10:38 -

引用なし
パスワード
   おはようございますチロです
ichinoseさん早速のご回答ありがとうございます
今から試してみます。

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