エクセルにて、クリックした場所にテキストボックスを貼り付け

Question

エクセルにて、クリックした場所にテキストボックスを貼り付けていきたいのですが、上手くvbaが組めません。どなたか、助けてください。
実際は、エクセル上の任意の場所にクリックするたびに、テキストボックスに数字を入れたものを1〜100まで、プロットする必要があり、定期作業のため、効率化を図りたいと考えております。

fujillin · Accepted Answer

こんにちは

既に回答が出ているので、ご参考までに。

#1様との違いは、以下の点です。
・マウスポインタの位置にテキストボックスを追加します
　（#1様の回答はセル位置に追加されますが、ボックスの左上がマウス位置になるように追加します）
・自動的にナンバリングします（1～100）
　（現状のままだと使い易いのか、使いにくいのかわかりませんが(笑)、自動ナンバリングのヒントとして…）

※ テキストボックスのサイズ、色等は適宜調整願います
※ 「クリックに反応」だと他のマウス操作ができなくなってしまうので、ひとまず、ダブルクリックにしてありますが、#1様ご提案のコマンドに追加する方式が使いやすそうな気がしますので、そのようにする方が良いかもしれません。

標準モジュールに
Private counter As Integer
Const ratio = 72 / 96
Private Type POINTAPI
　X As Long
　Y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Sub TextBoxWithNumber()
Dim p As POINTAPI
Dim X As Single, Y As Single, Z As Single
Dim tbx As Shape

GetCursorPos p
Z = ActiveWindow.Zoom / 100
X = (p.X - ActiveWindow.PointsToScreenPixelsX(0)) * ratio / Z
Y = (p.Y - ActiveWindow.PointsToScreenPixelsY(0)) * ratio / Z

Set tbx = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, 22, 22)
counter = (counter Mod 100) + 1

tbx.Fill.ForeColor.RGB = RGB(255, 255, 255)
tbx.Line.ForeColor.RGB = RGB(125, 125, 125)
tbx.Line.Weight = 0.25
With tbx.TextFrame2
　.MarginLeft = 0
　.MarginRight = 0
　.MarginTop = 0
　.MarginBottom = 0
　.VerticalAnchor = msoAnchorMiddle
　.HorizontalAnchor = msoAnchorCenter
　.TextRange.Font.Size = 10
　.TextRange.Characters.Text = str(counter)
End With
End Sub

シートモジュールに
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　Call TextBoxWithNumber
End Sub

fujillin · Answer

No2です

＞実際は、図面データ（画像）の任意の位置へテキストボックスへ
＞プロットしていく使用方法となります。
あれっ！？
それって、エクセルに貼り付けた画像の上にテキストボックスを置いていくって意味ですよね？

もしそうだとすると、クリックやダブルクリックではセルのイベントが発生しないので、No2のコードではうまくいかないように推測しますけれど？（セルの背景として画像を入れ込むようなことはできなかったように思いますので…）

基本的にNo1様のコードとNo2のコードの処理内容はほとんど同じですし、はからずも構成も似たものになってます。
（イベントあるいはコマンド取得部分と、実際の処理部分を分けた構成になっている）
違いはNo2にも示しましたが、トリガー（きっかけ）が異なることと、挿入位置を決めるのにマウス位置/セル位置のどちらから求めているかだけと言ってもよいくらいでしょう。（内容の違う部分はコードも異なりますが）

＞ダブルクリックに拘らず、他にいい方法はないでしょうか？？
シート上では（No2にも記したように）操作のためのクリックイベントは直接は拾えないと思いますが、挿入した画像上であればクリックイベントを拾うことが可能ですので、クリックで動作するように変えてあげれば、そのまま使えるはずと思います。
あるいは、キーボードとの併用になりますが、ショートカットを割り当てておいてキーの押下げでテキストボックスを追加するようにしておくとか、いろいろ方法はあるものと思います。

実際にどのような使い方になるのかがわかりませんので、質問者様（あるいは使う方）の使いやすい方法に設定しておくのが宜しいかと思います。
（上でも述べましたが）たまたまとは言え、No1、2ともトリガー部分と実処理部分が別構成になっているので、トリガー部分をを入れ変えるだけで組み換えが可能なはずと思います。

ところで、自動ナンバリングに関しては、No2のままだと番号を変えたい時や、途中から作業継続したい時などに開始番号を指定できないので、実際の使用に供するには不十分ではないかと想像します。
ですので（多分）、最低でも開始番号をセット可能なようにしておいた方がよさそうに思います。
とはいっても、counter変数に値をセットするだけの簡単な処理なので、別に作成しておいて、必要な時に実行すれば済みますね。（頻度が多いわけではないでしょうから）
いっそのこと、counter変数の代わりにシート上の固定セルを利用するようにしてしまえば、そのセルの値を直接編集することで番号を指定できるようにもなるので、そちらの方が良いのかも知れません。

よろずやkinchan · Answer

画像にということなら、No.2さんの回答でいいと思いますが、
ダブルクリックがいいのか右クリックがいいのかは、あなたが選択することです。
プロットするということは、テキストボックスではなく、本当は「吹き出し」を描きたいのでは？
あとは、マクロをどこに書くかですね。
エクセルで他の作業をする場合に邪魔にならない様にする為にどうしたいか？

よろずやkinchan · Answer

個人用マクロブックに作ってみました。
ThisWorkbook に以下を。
Option Explicit
Private Sub Workbook_Open()
　With Application.CommandBars("Cell").Controls.Add _
　　(Type:=msoControlButton, ID:=2950, Temporary:=True)
　　.Caption = "テキストボックスの貼り付け"
　　.FaceId = 3143
　　.OnAction = "テキストボックスの貼り付け"
　End With
End Sub
標準モジュールに以下を。
Option Explicit
Sub テキストボックスの貼り付け()
　With ActiveWindow.RangeSelection
　　ActiveSheet.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal _
　　　　, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select
　End With
　With Selection.ShapeRange(1).TextFrame2
　　.MarginTop = 0
　　.MarginBottom = 0
　　.MarginRight = 0
　　.MarginLeft = 0
　　.VerticalAnchor = msoAnchorMiddle
　　.HorizontalAnchor = msoAnchorCenter
　End With
End Sub

エクセルにて、クリックした場所にテキストボックスを貼り付け

こんにちは

No2です

画像にということなら、No.2さんの回答でいいと思いますが、

個人用マクロブックに作ってみました。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング