人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Visio2010を使用して、visioで作成された複数のファイル(図、表などの内部にテキストがあるものが混在する)の中のテキストを検索置換することは可能でしょうか?検索置換の用語はExcelファイルで一覧になっている(数百語あります)ので、これを読み込むか、あらかじめvisioの中に取り込んで一括検索置換できないかと考えています。

●質問者: caji
●カテゴリ:コンピュータ
✍キーワード:Excel Visio テキスト ファイル 作成
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● koriki-WeKan
●23ポイント

できない


VBAでプログラムを組めば可能かもしれないが、詳しい条件が分からないので何とも言えない。

http://q.hatena.ne.jp/

◎質問者からの返答

ソフトウェアの画面設計書の他言語から日本語への翻訳作業です。検索用、置換用に該当する2列が存在するエクセルファイルが存在します。エクセルファイルから取得した情報で、一括検索置換するVBAのサンプルプログラムがあれば教えていただきたいです。他に必要な条件があれば返答いたします。


2 ● ニャンざぶろう
●23ポイント

コメント欄が開放されておりませんので回答欄からすいません。

http://iyn.cocolog-nifty.com/iyn_blog/2009/04/visio-excel-54a.ht...

を見ると

>Visio の図形の一つ一つを for each 文によりたぐり寄せて検索することができます。

ということなので、この手繰り寄せてきたオブジェクトに置換後の文字列を上書きすれば置換できるかと。

ただ体裁を気にする場合、図形内文字列の置換で置換後の文字列の方が長い場合の処理が大変だと思います。

◎質問者からの返答

ありがとうございます。

試しに書いてみましたが、動きませんでした。

Replace関数が間違っているようですが、正しい書き方がわかりません。

教えていただけますと助かります。

Sub Searchandreplace()

Dim Str As String

Dim textFind1 As String

Set vsoShapes = ActiveDocument.Application.ActivePage.Shapes

For Each vsoShape In vsoShapes

If CStr(textFind1) = vsoShape.Characters.Text Then

vsoShape.Characters.Text.Replace(Str, "text1", "テキスト1")

End If

End Sub


3 ● cx20
●34ポイント

Visio の VBA より、Excel ファイルの検索・置換用ワードを取得し置換するサンプルコードを用意致しました。


Excel ファイルは以下の仕様を想定しています。

ブック名:[book1.xls] / シート名:[Sheet1]

A B
1 検索用 置換用
2 hatena はてな
3 google グーグル
4 yahoo ヤフー

コード実行の前に、

をご確認お願いします。

Option Explicit

' ログファイルの出力先を指定します
Const g_strLogFile = "C:\home\edu\hatena\caji\1278579260\DebugPrint.Log"

' 検索・置換用ワードを格納したExcelファイルを指定します
Const g_strExcelFile = "C:\home\edu\hatena\caji\1278579260\book1.xls"

' オートシェイプのテキストを辞書を使用して日本語に変換します。
Sub ConvertShapeTextToJapanese()
 Dim cn
 Set cn = CreateObject("ADODB.Connection")
 
 Dim strFileName
 strFileName = g_strExcelFile
  ' Excel に接続する為の接続文字列を指定します。項目名が無い(1行目からデータが始まる)場合は「HDR=No」を指定します。
 cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName & ";Extended Properties=""Excel 8.0;HDR=Yes;"""
 
 Dim rs
  ' Excel のシート名が「Sheet1」でない場合、下記の名称を変更してください。
 Set rs = cn.Execute("SELECT * FROM [Sheet1$]")
 
 Dim strFind
 Dim strReplace
  ' Excel の検索・置換用ワードをレコード件数分、順次取得します
 While Not rs.BOF And Not rs.EOF
 strFind = rs(0)  ' 検索用ワードを取得
 strReplace = rs(1) ' 置換用ワードを取得
  ' オートシェイプのテキストの置換処理を実行します
 UpdateShapeText strFind, strReplace
 rs.MoveNext
 Wend

End Sub


' オートシェイプのテキストの置換処理
Function UpdateShapeText(strFind, strReplace)
 Dim shpItem
  ' オートシェイプのコレクションのアイテムを順次取得します
 For Each shpItem In ActivePage.Shapes
  ' オートシェイプのテキストに検索用ワードがある場合のみ置換処理を実行します
 If InStr(shpItem.Text, strFind) > 0 Then
  ' デバッグ用にメッセージを出力します。
  ' 例)「サーバー.Text = Replae( "hatena1", "hatena", "はてな")」
 DebugPrint shpItem.Name & ".Text = Replae( """ & shpItem.Text & """, """ & strFind & """, """ & strReplace & """)"
  ' オートシェイプのテキストの検索用ワードを置換用ワードで置換します。
 shpItem.Text = Replace(shpItem.Text, strFind, strReplace)
 End If
 Next
End Function

' デバッグ文字列の出力
Function DebugPrint(strData)
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 With fso.OpenTextFile(g_strLogFile, 8, True) ' 追加書き込みモード
 .WriteLine strData
 .Close
 End With
End Function

また、コメント欄(デフォルトでは有効化されていません)を有効化していただけると助かります。


以下は VBA より Excel データを取得する方法に関する参考情報です。

■ [HOWTO] Visual Basic または VBA から ADO を Excel データで使用する
http://support.microsoft.com/kb/257819/
◎質問者からの返答

まことにありがとうございます。

記載いただいた方法でパスなどを変更して実行したところ、動作していることを確認できました。

複数のシート、複数のファイルに対して実行するように設定することも可能でしょうか。

#コメント欄を有効にしました。書込みできますでしょうか。


4 ● cx20
●10ポイント ベストアンサー

複数のシート、複数のファイルに対して実行するように設定することも可能でしょうか。

複数の Visio ドキュメントファイルならびに複数ページに対応したスクリプトを作成しました。

以下の点に注意して実行をお願いします。

1. 以下のスクリプトのソースを適当なエディタに貼り付けてください。
2. ソース内の Visio ドキュメントファイルのパスを設定します。
  「g_strVisioFilePath」に変換対象の Visio ドキュメントファイルのパスを設定します。
3. スクリプトを名前を付けて保存します。
  「UpdateVisioDocument.vbs」とします。
4. コマンドプロンプトにてスクリプトを実行します。
  プログラムを置いてある場所に移動し、
  CScript //Nologo UpdateVisioDocument.vbs
  を実行します。
5. スクリプトを実行すると、順次ファイルを変換します。
  実行時にバックアップファイルは作成しておりません。
  必ず、事前に Visio ドキュメントファイルのバックアップを取得願います。
<プログラムの概要>
1. ファイル数ループします。
└2. ページ数ループします。
 └3. 置換用 Excel のレコード数ループします。
  └4. ページ内のオートシェイプの数ループします。
   └5. オートシェイプのテキストを置換します。

' File : UpdateVisioDocument.vbs
' Usage : CScript //Nologo UpdateVisioDocument.vbs
Option Explicit

' VisOpenSaveArgs の定数
Const visOpenMacrosDisabled = &H80

' ログファイルの出力先を指定します
Const g_strLogFile = "C:\home\edu\hatena\caji\1278579260\DebugPrint.Log"

' 検索・置換用ワードを格納したExcelファイルを指定します
Const g_strExcelFile = "C:\home\edu\hatena\caji\1278579260\book1.xls"

' Visio ファイルの配置場所を指定します。
Const g_strVisioFilePath = "C:\home\edu\hatena\caji\1278579260\data"

' メイン処理を呼び出します
Call Main()

Sub Main()
  ' 複数の Visio ドキュメントを Excel ファイルの内容で更新する処理を呼び出します。
 Call UpdateVisioDocuments( g_strVisioFilePath, g_strExcelFile )
End Sub

' 複数の Visio ドキュメントを Excel ファイルの内容で更新する処理
Function UpdateVisioDocuments( strVisioFilePath, strExcelFile )
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 Dim folder
 Set folder = fso.GetFolder( strVisioFilePath )
 Dim file
  ' 指定したフォルダ内のファイル名を順次取得します
 For Each file In folder.Files
 Dim strFileExt
 strFileExt = fso.GetExtensionName( file.Name )
 If LCase(strFileExt) = "vsd" Then
 DebugPrint "File Name = [" & file.Name & "]"
  ' 単一の Visio ドキュメントを Excel ファイルの内容で更新する処理を呼び出します
 Call UpdateVisioDocument( strVisioFilePath & "\" & file.Name, strExcelFile )
 End If
 Next
End Function

' 単一の Visio ドキュメントを Excel ファイルの内容で更新する処理
Function UpdateVisioDocument( strVisioFile, strExcelFile )
 Dim app
 Set app = CreateObject("Visio.Application") ' Visio のプロセスを起動します。
 app.Visible = True ' Visio のプロセスを表示状態に変更します。
 Dim doc
 Set doc = app.Documents.OpenEx( strVisioFile, visOpenMacrosDisabled )
 
 Dim page
 For Each page In doc.Pages
 DebugPrint "[" & page.Name & "]"
  ' オートシェイプのテキストを Excel ファイルの内容で更新する処理を呼び出します
 Call UpdateShapeTextByReplaceFile( page, strExcelFile )
 Next
 doc.Save  ' ファイルを上書き保存します
 doc.Close
 app.Quit  ' Visio のプロセスを終了します
End Function

' オートシェイプのテキストを Excel ファイルの内容で更新する処理
Sub UpdateShapeTextByReplaceFile( ByRef page, strExcelFile )
 Dim cn
 Set cn = CreateObject("ADODB.Connection")
 
 Dim strFileName
 strFileName = g_strExcelFile
  ' Excel に接続する為の接続文字列を指定します。項目名が無い(1行目からデータが始まる)場合は「HDR=No」を指定します。
 cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName & ";Extended Properties=""Excel 8.0;HDR=Yes;"""
  ' 64bit OS の場合は、Jet.OLEDB が使用できない為、以下を有効化します。
  'cn.Open "PROVIDER=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";Extended Properties=""Excel 8.0;HDR=Yes;"""
 
 Dim rs
  ' Excel のシート名が「Sheet1」でない場合、下記の名称を変更してください。
 Set rs = cn.Execute("SELECT * FROM [Sheet1$]")
 
 Dim strFind
 Dim strReplace
  ' Excel の検索・置換用ワードをレコード件数分、順次取得します
 While Not rs.BOF And Not rs.EOF
 strFind = rs(0)  ' 検索用ワードを取得
 strReplace = rs(1) ' 置換用ワードを取得
  ' オートシェイプのテキストを置換する処理を呼び出します
 Call UpdateShapeTextByReplaceText( page, strFind, strReplace )
 rs.MoveNext
 Wend

End Sub

' オートシェイプのテキストを置換する処理
Function UpdateShapeTextByReplaceText( ByRef page, strFind, strReplace )
 Dim shpItem
  ' オートシェイプのコレクションのアイテムを順次取得します
 For Each shpItem In page.Shapes
  ' オートシェイプのテキストに検索用ワードがある場合のみ置換処理を実行します
 If InStr(shpItem.Text, strFind) > 0 Then
  ' デバッグ用にメッセージを出力します。
  ' 例)「サーバー.Text = Replae( "hatena1", "hatena", "はてな")」
 DebugPrint shpItem.Name & ".Text = Replae( """ & shpItem.Text & """, """ & strFind & """, """ & strReplace & """)"
  ' オートシェイプのテキストの検索用ワードを置換用ワードで置換します。
 shpItem.Text = Replace(shpItem.Text, strFind, strReplace)
 End If
 Next
End Function

' デバッグ文字列の出力
Function DebugPrint( strMessage )
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 Dim file
 Set file = fso.OpenTextFile(g_strLogFile, 8, True) ' 追加書き込みモード
 WScript.Echo strMessage
 file.WriteLine strMessage
 file.Close
End Function

以下は参考情報です。

■ Microsoft Office Visio オートメーション リファレンス
http://msdn.microsoft.com/ja-jp/library/cc345404.aspx

不明な点等ございましたら、コメント等追加お願い致します。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ