Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11694 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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さん早速のご回答ありがとうございます
今から試してみます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11694 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free