図の挿入

表示例はこちら

本文中リンクの部分はどうなっているか

それぞれの辞書フォルダにJPGがあり、そこに図が入っています。
本文中にリンクが貼られていますが、自動化は結構困難です。
まず本文中に『図1-2』などと張ってある場合は実際の図と比較すればよいです。
本文中に『図』とだけ張ってある場合、お手上げです。
まずは本文中から『図1-2[図]』となっている部分を抽出します。

のように画像名リスト(テキストファイル)が作られます。

<img src="\JPG\HIFA002Z00347003.jpg" alt="図1-2 ">

のように変換して本文中に埋め込めば完了です。その手順を以下に書きます。

図のファイル名との対応

この順にファイルが対応すればよいのですが、とてもとてもそうはいきません。

VBAを使います。

フォルダを指定してファイル名を列挙し、名前順に並べ替えてワークシートに書き込みます。

Sub　ファイル名セット()
　Dim　d　As　String,　Pa　As　String
　Pa　=　"C:\Documents　and　Settings\河合正巳\デスクトップ\今日の治療2009Dic\element\sinrinJPG\"
　d　=　"C:\Documents　and　Settings\河合正巳\デスクトップ\今日の治療2009Dic\AV化\list臨床内科学.XLS"
　SQLSheet　d,　Pa
End　Sub
Sub　SQLSheet(Fname　As　String,　Pa　As　String)
　On　Error　Resume　Next
　Const　adOpenStatic　=　3
　Const　adLockOptimistic　=　3
　Const　adCmdText　=　&H1
　Set　objConnection　=　CreateObject("ADODB.Connection")
　Set　RS　=　CreateObject("ADODB.Recordset")
　objConnection.Open　"Provider=Microsoft.Jet.OLEDB.4.0;"　&　_
　　"Data　Source="　+　Fname　+　";"　&　_
　　　"Extended　Properties=""Excel　8.0;HDR=Yes;"";"
　Dim　i　As　Integer,　SQL　As　String
　Dim　fs,　f,　f1,　fc,　s
　Set　fs　=　CreateObject("Scripting.FileSystemObject")
　Set　f　=　fs.GetFolder(Pa)
　Set　fc　=　f.Files
　For　Each　f1　In　fc
　　i　=　i　+　1
　　SQL　=　"insert　into　[Sheet2$](path,fn,num)values('"　+　f1.Name　+　"','"　+　桁調節(i,　5)　+　"','77')"
　　RS.Open　SQL,　_
　　objConnection,　adOpenStatic,　adLockOptimistic,　adCmdText
　Next
　RS.Close
End　Sub

こんな感じにimageを並べます。

まずは画像を表示します。テキストボックスに入力されている数字から6枚を表示します。

同時にそのイメージのコントロールチップにその図のファイル名を書き込みます。

Sub　iphonepicreload()
　Dim　SQL　As　String,　Fname　As　String
　Dim　d　As　String,　Pa　As　String
　d　=　"C:\Documents　and　Settings\河合正巳\デスクトップ\今日の治療2009Dic\element\sinrinJPG\"
　Fname　=　"C:\Documents　and　Settings\河合正巳\デスクトップ\今日の治療2009Dic\AV化\list臨床内科学.XLS"
　SQL　=　"select　*　from　　[Sheet2$]　where　FN>'"　+　桁調節(Me.TextBox1,　5)　+　"'　order　by　fn"
　On　Error　Resume　Next
　Const　adOpenStatic　=　3
　Const　adLockOptimistic　=　3
　Const　adCmdText　=　&H1
　Set　objConnection　=　CreateObject("ADODB.Connection")
　Set　RS　=　CreateObject("ADODB.Recordset")
　objConnection.Open　"Provider=Microsoft.Jet.OLEDB.4.0;"　&　_
　　　"Data　Source="　+　Fname　+　";"　&　_
　　　　　"Extended　Properties=""Excel　8.0;HDR=Yes;"";"
　　RS.Open　SQL,　_
　　objConnection,　adOpenStatic,　adLockOptimistic,　adCmdText
　Me.Image1.Picture　=　LoadPicture(d　+　RS.Fields("path"))
　Me.Image1.ControlTipText　=　RS.Fields("path")
　RS.MoveNext
　Me.Image2.Picture　=　LoadPicture(d　+　RS.Fields("path"))
　Me.Image2.ControlTipText　=　RS.Fields("path")
　RS.MoveNext
　Me.Image3.Picture　=　LoadPicture(d　+　RS.Fields("path"))
　Me.Image3.ControlTipText　=　RS.Fields("path")
　RS.MoveNext
　Me.Image4.Picture　=　LoadPicture(d　+　RS.Fields("path"))
　Me.Image4.ControlTipText　=　RS.Fields("path")
　RS.MoveNext
　Me.Image5.Picture　=　LoadPicture(d　+　RS.Fields("path"))
　Me.Image5.ControlTipText　=　RS.Fields("path")
　RS.MoveNext
　Me.Image6.Picture　=　LoadPicture(d　+　RS.Fields("path"))
　Me.Image6.ControlTipText　=　RS.Fields("path")
　RS.Close
　Me.Repaint
End　Sub

ボタン3つは、それぞれ更新、6枚戻す、6枚送りです。

Private　Sub　CommandButton1_Click()
　iphonepicreload
End　Sub
Private　Sub　CommandButton2_Click()
　Me.TextBox1　=　Me.TextBox1　+　6
　iphonepicreload
End　Sub
Private　Sub　CommandButton3_Click()
　Me.TextBox1　=　Me.TextBox1　-　6
　iphonepicreload
End　Sub

書くイメージボックスはクリックすると、そのファイル名をクリップボードに渡します。6枚目をクリックしたときは自動で6枚先へ更新します。

Private　Sub　Image1_Click()
　toClip　Me.Image1.ControlTipText
End　Sub
Private　Sub　Image2_Click()
　toClip　Me.Image2.ControlTipText
End　Sub
・・・
Private　Sub　Image6_Click()
　toClip　Me.Image6.ControlTipText
　Me.TextBox1　=　Me.TextBox1　+　6
　iphonepicreload
End　Sub

フォームを立ち上げるとこうなります。図の番号が下の方に表示されているので、これを画像名リストにペーストしていきます。

このようなリストが出来ます。

これを<img src="\JPG\HIFA002Z00347003.jpg" alt="図1-1 ">などに変換する秀丸マクロを作ります。

手作業では死んでしまうので、マクロを作る秀丸マクロを作ります。

簡単に言えば

1.文頭に　　　replaceallfast "　　　　を挿入する。
2.　　[図] 　　を　　　\\f\\[図\\]","<img src=\\\"\\\\JPG\\\\　　　にする
3.最後に　　　//\\\" alt=\\\"\\\0\\\">",regular;　　　　　をいれる。

秀丸マクロでは

replaceallfast "^","replaceallfast \\\"",regular;
replaceallfast "\\[図\\]\t","\\\\\\\\f\\\\\\\\\\[図\\\\\\\\\\]\\\",\\\"<img src=\\\\\\\\\\\\\"\\\\\\\\\\\\\\\\seiJPG\\\\\\\\\\\\\\\\",regular;
replaceallfast "$","\\\\\\\\\\\\\" alt=\\\\\\\\\\\\\"\\\\\\\\\\\\0\\\\\\\\\\\\\">\",regular;",regular;

正規表現のエスケープ文字の関係で　\　の羅列になってしまいました。

例外処理

1.変則

皮膚科では
図1-74,75 [図] [図]
のような箇所が4カ所ありました。
これはいったん

replaceallfast "図1-74,75 [図] [図]","図1-74 [図]、図1-75 [図]";

で分けていきます。

2.一つの図でたくさんの引用がある場合

たとえば10-3aだけ図を表示し、残りは図を表示せず、文字だけ残します。

replaceallfast "図10-3b [図]","図10-3b ";
replaceallfast "図10-3c [図]","図10-3c ";
replaceallfast "図10-3d [図]","図10-3d ";
replaceallfast "図10-3e [図]","図10-3e ";
replaceallfast "図10-3f ","図10-3f [図]";
replaceallfast "図10-3g [図]","図10-3g ";
replaceallfast "図10-3h [図]","図10-3h ";
replaceallfast "図10-3i [図]","図10-3i ";

かくして辞書ごとの変換マクロが出来ます。

replaceallfast "図1-1a,b \\f\\[図\\]","<img src=\\\"\\\\seiJPG\\\\SEIA001B001Z00017001.jpg\\\" alt=\\\"\\\0\\\">",regular;
replaceallfast "図1-2a \\f\\[図\\]","<img src=\\\"\\\\seiJPG\\\\SEIA001B001Z00027001.jpg\\\" alt=\\\"\\\0\\\">",regular;
replaceallfast "図1-3 \\f\\[図\\]","<img src=\\\"\\\\seiJPG\\\\SEIA001B001Z00039001.jpg\\\" alt=\\\"\\\0\\\">",regular;
replaceallfast "図1-4 \\f\\[図\\]","<img src=\\\"\\\\seiJPG\\\\SEIA001B001Z00049001.jpg\\\" alt=\\\"\\\0\\\">",regular;
replaceallfast "図1-5 \\f\\[図\\]","<img src=\\\"\\\\seiJPG\\\\SEIA001B001Z00077001.jpg\\\" alt=\\\"\\\0\\\">",regular;
replaceallfast "図1-6 \\f\\[図\\]","<img src=\\\"\\\\seiJPG\\\\SEIA001B001Z00077002.jpg\\\" alt=\\\"\\\0\\\">",regular;

皮膚科で520行のreplace分の羅列です。これで本ファイル上で実行するとできあがりです。

皮膚科、整形にリンクを貼って10個の辞書を一気に変換、1分で図入りの辞書作成。

wifiで

転送時間は298MBを3分4秒。

戻る