VBS2年目のプログラマーです。
Excelで図形オートシェイプ内のテキストが検索できないので、
マクロを作成してみようと思いましたが2点問題が発生しましたので
解決方法または実現方法をご教授ねがいます。
(目標マクロ機能概要)
(1)InputBoxで検索文字列を入力
(2)検索文字列と一致するテキストを持つ図形を選択
(3)検索文字列と一致する次の図形を検索するかをMsgboxから選択
(この時、一致する図形は選択されている状態であってほしい)
(4)(3)で次の図形を検索しない、または図形をすべて検索するとマクロ終了
(問題)
1.機能概要(2)の選択される図形が現在のExcel画面外にある場合、画面が移動しないため、どこに検索ヒットした図形があるか使用者がわからない
2.機能概要(3)で、Msgbox実行時に図形選択が表示されず現在どの図形を選択しているのか使用者がわからない
問題1は、autoshapeオブジェクトのtop,left属性などを
使うしかないのかなとぼんやり考えています。
以下、コードです。
お忙しいところ、申し訳ありませんが
以上、よろしくお願いします。
**************************
Sub GetShapesText()
Dim wk_shp As Shape 'オートシェイプ格納変数
Dim wk_search_str As String '検索文字列変数
'*** 検索文字列入力処理 ***
wk_search_str = InputBox("検索する図形オートシェイプのテキストを入力してください。", "オートシェイプ内テキスト検索")
If (Len(wk_search_str) = 0) Then
'検索文字列が未入力の場合は、マクロ終了
Exit Sub
End If
'*** オートシェイプ検索処理 ***
For Each wk_shp In ActiveSheet.Shapes
If InStr(wk_shp.Name, "Line") = 0 Then 'オートシェイプが線(Line)以外の場合のみ以下を処理
If (InStr(wk_shp.TextFrame.Characters.Text, wk_search_str) > 0) Then 'オートシェイプのテキストに検索文字列が含まれる場合のみ以下を処理
wk_shp.Select '検索ヒットしたオートシェイプを選択
wk_next_search_flg = MsgBox("次を検索しますか?", vbYesNo)
If (wk_next_search_flg = 7) Then
'次を検索しない場合は、検索を終了
Exit For
End If
End If
End If
Next
End Sub
**************************
No.1ベストアンサー
- 回答日時:
こんにちは。
QNo.2107566 を参考にして、TextBoxを使うか、
wk_shp.DrawingObject.Select
...とすれば良いです。
(DrawingObject も TextBox も隠しObjectですが、便利ですよ)
No.4
- 回答日時:
またまた登場、onlyromです。
VBAには慣れていらっしゃるようなのでお気づきだとは思いますが、一言。
>'●●● 図形の乗ってるセルを表示画面の左上隅へ移動
>ActiveWindow.ScrollRow = Selection.TopLeftCell.Row - 1
>ActiveWindow.ScrollColumn = Selection.TopLeftCell.Column - 1
これは表示画面の左上隅(セルA1)ではなくより見やすくするために、
表示画面のセルB2の位置に表示しているわけですが、
-1 をしてますので当然、実際の図形が、1行目または1列目にあった場合はエラーになりますので、
そこらは修正願います。
もちろん、-1 を省いてもいいですが。。。
No.3
- 回答日時:
1.TopLeftCell.Selectで画面移動
2.選択表示用のシェープで表示
問題点追加
If InStr(wk_shp.Name, "Line") = 0 Then 'オートシェイプが線(Line)以外の場合のみ以下を処理
ではなく
If wk_shp.Type = msoTextBox Then 'オートシェイプがtextboxの場合のみ以下を処理
で処理対象を選択にしないと、line以外のシェープも対象になり、wk_shp.TextFrame.Characters.Textでエラーになる。
という訳で、以下ではどうでしょうか?
Sub GetShapesText()
Dim wk_shp As Shape 'オートシェイプ格納変数
Dim wk_search_str As String '検索文字列変数
Dim wk_next_search_flg As Integer
'選択表示用のダミーシェープ
Dim mark1 As Shape
Dim mark2 As Shape
Dim mark3 As Shape
Dim mark4 As Shape
Set mark1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 5, 5)
Set mark2 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 5, 5)
Set mark3 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 5, 5)
Set mark4 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 5, 5)
'*** 検索文字列入力処理 ***
wk_search_str = InputBox("検索する図形オートシェイプのテキストを入力してください。", "オートシェイプ内テキスト検索")
If (Len(wk_search_str) = 0) Then
'検索文字列が未入力の場合は、マクロ終了
Exit Sub
End If
'*** オートシェイプ検索処理 ***
For Each wk_shp In ActiveSheet.Shapes
'If InStr(wk_shp.Name, "Line") = 0 Then 'オートシェイプが線(Line)以外の場合のみ以下を処理
If wk_shp.Type = msoTextBox Then 'オートシェイプがtextboxの場合のみ以下を処理
If (InStr(wk_shp.TextFrame.Characters.Text, wk_search_str) > 0) Then 'オートシェイプのテキストに検索文字列が含まれる場合のみ以下を処理
'wk_shp.Select '検索ヒットしたオートシェイプを選択
'選択表示用のダミーシェープ表示位置
mark1.Left = wk_shp.Left - 2
mark1.Top = wk_shp.Top - 2
mark2.Left = wk_shp.Left + wk_shp.Width - 2
mark2.Top = wk_shp.Top - 2
mark3.Left = wk_shp.Left - 2
mark3.Top = wk_shp.Top + wk_shp.Height - 2
mark4.Left = wk_shp.Left + wk_shp.Width - 2
mark4.Top = wk_shp.Top + wk_shp.Height - 2
'選択シェープのあるセルにフォーカスを移動
wk_shp.TopLeftCell.Select
wk_next_search_flg = MsgBox("次を検索しますか?", vbYesNo)
'If (wk_next_search_flg = 7) Then
If (wk_next_search_flg = vbNo) Then
'次を検索しない場合は、検索を終了
Exit For
End If
End If
End If
Next
'選択表示用のダミーシェープ削除
mark1.Delete
mark2.Delete
mark3.Delete
mark4.Delete
End Sub
p.s.
ANo.1さんのDrawingObjectというのは、初めて知りました。
こういうのもあるんですね。
No.2
- 回答日時:
(1)選択した図形が表示画面を外れていた場合
選択した図形を表示画面の左上隅へ表示する
乗ってるセルを表示画面の左上隅へ移動させればいい
(2)MsgBox表示でどの図形を選択しているか不明になる
これは仕方のないことなので代案として
選択した図形を「決まった色(例えば黄色)」に塗りつぶし
MsgBoxが消えたときもとの色にもどしておく
という感じでどうでしょう。
'-------------------------------------------------
Sub GetShapesText()
Dim wk_shp As Shape 'オートシェイプ格納変数
Dim wk_search_str As String '検索文字列変数
Dim wk_next_search_flg
Dim myIro As Integer
'*** 検索文字列入力処理 ***
wk_search_str = InputBox("検索する図形オートシェイプのテキストを入力してください。", "オートシェイプ内テキスト検索")
If (Len(wk_search_str) = 0) Then
'検索文字列が未入力の場合は、マクロ終了
Exit Sub
End If
'*** オートシェイプ検索処理 ***
For Each wk_shp In ActiveSheet.Shapes
If InStr(wk_shp.Name, "Line") = 0 Then 'オートシェイプが線(Line)以外の場合のみ以下を処理
If (InStr(wk_shp.TextFrame.Characters.Text, wk_search_str) > 0) Then 'オートシェイプのテキストに検索文字列が含まれる場合のみ以下を処理
wk_shp.Select '検索ヒットしたオートシェイプを選択
'●●● 図形の乗ってるセルを表示画面の左上隅へ移動
ActiveWindow.ScrollRow = Selection.TopLeftCell.Row - 1
ActiveWindow.ScrollColumn = Selection.TopLeftCell.Column - 1
'●●● 選択した図形の塗りつぶし色を保持
'●●● 選択した図形が分かるように黄色に塗りつぶす&再描画
myIro = Selection.ShapeRange.Fill.ForeColor.SchemeColor
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
DoEvents
wk_next_search_flg = MsgBox("次を検索しますか?", vbYesNo)
'●●● 選択した図形の色を元へ戻す
Selection.ShapeRange.Fill.ForeColor.SchemeColor = myIro
If (wk_next_search_flg = 7) Then
'次を検索しない場合は、検索を終了
Exit For
End If
End If
End If
Next
End Sub
'--------------------------------------------
それから、ActiveXコントロールなどが配置してあると質問者の提示のコードではエラーが出ますがそれらはそのままの状態ですので、エラー処理はご自分で。
以上。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ユーザーフォームの表示を追加したい 2 2023/03/26 23:18
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
- Excel(エクセル) 指定文字列が該当するA列をアクティブセルにするには 3 2022/08/17 13:18
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Excel(エクセル) PHPプログラムをエクセルに張り付けると検索ボックスがでてくる! 3 2022/05/08 07:10
- Visual Basic(VBA) ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています 17 2022/12/07 12:03
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) InputBoxでキャンセルボタンを押したらファイル自体を閉じたい 3 2022/07/23 17:52
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
どうやってもFor文を抜けてしま...
-
IF文に時間(何時から何時ま...
-
【C#/Java?】try-catchでcatch...
-
iPhoneのニューラルエンジンっ...
-
特定の名前のオートシェイプの...
-
Excel VBA セルの名前があるか...
-
VB6にてネットワーク上にある共...
-
StatusStripの表示が更新されな...
-
エクセルVBAでロックをかけたい
-
ListViewから選択中の文字列を取得
-
特定のファイルを他のプロセス...
-
vbaのエラー対応(実行時エラー...
-
UWSCのTHREADについて
-
決まった時刻に処理を行いたい
-
Functionで戻り値を複数返す方法
-
C++ Builder6.0 TNMFTPコンポー...
-
C# 指定時間(秒間)の間処理を...
-
VBAの進捗状況をリアルタイ...
-
検索サイトで、検索結果に広告...
-
Windows APIのメソッドをPInvok...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【C#/Java?】try-catchでcatch...
-
private subモジュールを他のモ...
-
IF文に時間(何時から何時ま...
-
マクロで、次のコードへ行く前...
-
特定の名前のオートシェイプの...
-
シグナル 6(SIGABRT)とは?
-
特定のファイルを他のプロセス...
-
ExcelのVBAで、選択したファイ...
-
Excel VBA セルの名前があるか...
-
どう増強すべきか
-
Word VBA。各マクロの間に待ち...
-
【VBA】エラー処理で別プロシー...
-
UWSCのTHREADについて
-
シェルスクリプトでファイル内...
-
ドリブン??
-
Functionで戻り値を複数返す方法
-
iPhoneのニューラルエンジンっ...
-
エクセル VBAで複数セル選択時...
-
COBOL OCCURSで指定したデータ...
-
どうやってもFor文を抜けてしま...
おすすめ情報