【ExcelVBA】指定したフォルダ内のテキストボックス内にを指定した文字列が含まれているかを確認する

機械的な作業に関しては、ITを用いて業務処理を行った方が早く、正確に行うことができます。ITによる業務処理の統制として、機械的にできる作業は沢山ありますが、今回はテキストボックスに関する作業をやる機会があったので情報共有します。

STEP1：プログラムの概要

本プログラムは以下のようなエクセルファイル中のテキストボックスの値を対象にしている

※エクセル上のセルは対象外である

プログラムの含まれているシ一トは以下のものを前提とする。

該当する箇所に値を入力すると、入力したフォルダ内の全てのテキストボックスの値を確認したり、修正して値を変更することができます。

STEP2：使用する関数、考え方

〇グループ化したテキストボックスの取り扱いについて

【VBA】グループ化した図形内の図形の名前を取得【GroupItemsを使う】

Excel VBAで、グループ化した図形内の、図形の名前を取得する方法について、ご紹介します。グループ化した図形内の図形は、「GroupItems」を使います。やり方は、「For Each Next」を2回ループして、図形の中の図形を取得して、名前を取得するという流れです。具体的に解説していきます。

https://daitaideit.com/vba-shapes-groupitems/

〇文字列の改行について

オートシェイプ内テキストの改行コードはvbLF【図形】【ExcelVBA】

オートシェイプ内テキストの改行コードはvbLFである備忘録です。オートシェイプ内に文字入力をする案件がありました。 ————– ①マクロで改行コードを入力 ②改行コードの位置を判定する ③1行目の処理と2行目の処理を分

https://vba-create.jp/vba-shape-vblf-true/

〇文字色の指定について

【VBA】図形のテキストや文字色の取得と設定【.TextFrame.Charactersを使う】

Excel VBAで、図形のテキストや文字色の、取得と設定について、ご紹介します。図形のテキストを操作するには、「.TextFrame.Characters」を使います。テキスト、文字色、文字サイズ、太字、斜線、下線など、基本的な設定と取得について、解説していきます。

https://daitaideit.com/vba-shapes-text/

〇フォントの変更について

TextFrameのフォントを変更するには？？:エクセルマクロ・Excel VBAの使い方/図形内文字列

Excel VBAのTextFrameオブジェクトにはFontプロパティはなく、TextFrameの子オブジェクトであるChractersオブジェクトにFontプロパティはあります。

https://www.relief.jp/docs/excel-vba-textframe-font.html

STEP3：ソースコード

Sub CheckTextBox()
'----------------------------------------------
'概要: 指定したフォルダ内のテキストボックス内にを指定した文字列が含まれているかを確認する
'機能名: CheckTextBox
'引数: なし
'戻り値: なし
'備考:指定した文字がテキストボックスに含まれているファイルを検索する
'----------------------------------------------

	Dim myPath As String
	Dim kakutyoshi As String
	Dim search_str As String
	Dim replace_flg As integer
	Dim replace_str As String
	Dim myBook_name As String
	Dim mySheet_name As String
	Dim book_number As Long
	Dim grpcount As integer
	Dim grpShp As Shape
	Dim oneShp As Shape
	Dim verShp As Shape

	myPath = ThisWorkbook.Worksheets(1).Cells(1, 2).Value & "\\"
	kakutyoshi = ThisWorkbook.Worksheets(1).Cells(2, 2).Value
	search_str = ThisWorkbook.Worksheets(1).Cells(3, 2).Value
	replace_flg = ThisWorkbook.Worksheets(1).Cells(4, 2).Value
	replace_str = ThisWorkbook.Worksheets(1).Cells(5, 2).Value
	before_ver = ThisWorkbook.Worksheets(1).Cells(6, 2).Value
	replace_ver = ThisWorkbook.Worksheets(1).Cells(7, 2).Value
	'拡張子に値が設定されていなかったらデフォルトでxlsxをセット
	If kakutyoshi = "" Then
		kakutyoshi = "xlsx"
	End If
	'パス配下の設定した拡張子の最初のファイル名を返す
	myBook_name = Dir(myPath & "*" & kakutyoshi)
	book_number = 1
	'Dir関数がファイル名を返さなくなるまで繰り返す
	Do Until myBook_name = ""
		'ファイル名のブックを開く
		Workbooks.Open myPath & myBook_name
		i_page = 0
		l_sumpage = 0
		For Each mySheet In Workbooks(myBook_name).Worksheets
			'全てのテキストボックス内をループする
			For Each grpShp In mySheet.Shapes
				If grpShp.Type = msoGroup Then 'グループ化されている場合のみ処理
					'グループのカウントを取得
					grpcount = grpShp.GroupItems.Count
				Else 'グループ化されていない場合は、ループの回数を1回のみに設定する
					grpcount = 1
				End If
				'グループの中身のカウントだけループ
				For i = 1 To grpcount
					If grpShp.Type = msoGroup Then 'グループ化されている場合のみ処理
						'グループアイテムを取得
						Set oneShp = grpShp.GroupItems(i)
					Else
						'グループ化されていない場合は、shpをそのまま取得
						Set oneShp = grpShp
					End If
					
 					If oneShp.Type = msoTextBox Then 'テキストボックスのみ処理
 						If InStr(oneShp.TextFrame2.TextRange.Text, search_str) > 0 Then
							'1列目のセルにファイル名を書き込み
							ThisWorkbook.Worksheets(1).Cells(book_number + 10, 1).Value = myBook_name
							'2列目のセルにページ数を書き込み
							ThisWorkbook.Worksheets(1).Cells(book_number + 10, 2).Value = oneShp.TextFrame2.TextRange.Text
							If replace_flg <> 0 Then
								'テキストボックスの値の変更
								oneShp.TextFrame2.TextRange.Text = Replace(oneShp.TextFrame2.TextRange.Text, search_str, replace_str)
											'全てのテキストボックス内をループする
								For Each grp2Shp In mySheet.Shapes
									If grp2Shp.Type = msoGroup Then 'グループ化されている場合のみ処理
										'グループのカウントを取得
										grp2count = grp2Shp.GroupItems.Count
									Else 'グループ化されていない場合は、ループの回数を1回のみに設定する
										grp2count = 1
									End If
									'グループのカウントだけループ
									For j = 1 To grp2count
										If grp2Shp.Type = msoGroup Then 'グループ化されている場合のみ処理
											'グループアイテムを取得
											Set verShp = grp2Shp.GroupItems(j)
										Else
											'グループ化されていない場合は、shpをそのまま取得
											Set verShp = grp2Shp
										End If
 										If oneShp.Type = msoTextBox Then 'テキストボックスのみ処理
 											If before_ver <> "" Then
												If InStr(verShp.TextFrame2.TextRange.Text, before_ver) > 0 Then
													'versionを一つ変更
													verShp.TextFrame2.TextRange.Text = Replace(verShp.TextFrame2.TextRange.Text, before_ver, replace_ver)
													'更新履歴を作成する(前の更新履歴は残るので、手動で削除する)
													'With mySheet.Shapes.AddShape(msoShapeRectangle, 500, 50, 220, 103)
														'.Line.ForeColor.RGB = RGB(255, 0, 0)
														'.Line.Weight = 0.75
														'フォントをMS明朝に変更する(全角文字のフォント変更ができないので、手動で変更する)
														'.TextFrame.Characters.Font.Name = "ＭＳ 明朝"
														'.TextFrame.Characters.Font.Size = 11
														'.TextFrame.Characters.Text = "#" & vbCrLf & "Auther" & vbCrLf & "yyyy/mm/dd" & vbCrLf & "修正内容" 
														'.TextFrame.Characters.Font.Color = RGB(255, 0, 0)
													'End With
												End If
											End If
										End If
									Next
								Next
							End If
							'book番号を1増やす
							book_number = book_number + 1
						End If
					End If
				Next
			Next
		Next mySheet
		Application.DisplayAlerts = False
		'ブックが変更されていない
		IF Workbooks(mybook_name).Saved = True Then
			Workbooks(mybook_name).Close SaveChanges := False
		'ブックが変更されている
		Else
			Workbooks(mybook_name).Close SaveChanges := True
		End If
		Application.DisplayAlerts = True
		myBook_name = Dir
	Loop

End Sub