HotVBS 用スクリプトの事例

ホームページのトップに戻る目次

HotVBS と、関連ソフトのダウンロード

スクリプト事例ファイルの登録方法

VBScript の参考サイト

HotVBS の基本
 ・クリップ・ボードに書き込むときの注意

スクリプト事例と解説
 ・計算を実行:Eval 関数、Rnd 関数、メモ帳を開いて出力
 ・DDwinで辞書引き:アプリケーション起動
 ・サクラエディタでgrep
 ・テキストを「なでしこ」で実行:アプリケーション起動
 ・WScriptをHotVBSに:正規表現置換
 ・行末空白削除して連続空行を1行に
 ・半角英字の1文字目を大文字に、以下を小文字に
 ・カナ→ローマ字変換(Excelセル選択範囲一括):Excel操作
 ・カナ→ローマ字変換(Excelのセル一つずつ):Excel操作
 ・一行の文字数を指定して行数をカウント:シフト JIS の文字でバイト数カウント
 ・ソースコード整形:ファイルを開くダイアログボックス
 ・フォルダ内の指定拡張子のファイル名一覧表示:ファイルを開くダイアログボックス
 ・選択文字列を Google/DeepL で和⇔英テキスト翻訳:IEブラウザで、文字入力
 ・画像インライン表示:htmlのタグ挿入と、IEブラウザで表示
 ・テキスト・ファイを比較して、差分を別ファイルに出力
 ・テキスト比較(ソート済を前提)
 ・テキストファイルの先頭切り出し
 ・テキストファイルの頭と尻を切り出し
 ・複数テキストをバイナリ結合:ファイルをバイナリで読み書き
 ・青空文庫ルビタグ変換(漢字変数使用):テキスト・ファイルの読み書き
 ・ファイルを行ソート
 ・複数ファイルを複数行置換★:正規表現置換 ファイルシステム・オブジェクト
 ・UTF-8版 複数ファイルを複数行置換★:ADODB.Stream を使う
 ・複数のUTF8ファイルをShiftJISに一括変換(下位フォルダ含む):文字コードを変換
 ・階層付きテキストを第1レベルで分割
 ・IEで表示中のURLの一階層上を表示:IEのアクティブ画面の情報を取得
 ・ノーツ・メイル転送して削除(クリップボード):SendKeys

索引

 HotVBS は、起動時に常駐させると便利です。
 スタートアップに登録して、電源起動時に常駐させる方法を参照下さい。
 
←リンク元に戻る

HotVBS と、関連ソフトのダウンロード

 HotVBS は、桝岡 秀昭さんが作成されたアプリです。
 HotVBS の使い方と、ダウンロード
http://www.ac.cyberhome.ne.jp/~v-tails/delphi/hotvbs.html
https://sites.google.com/view/v-tails/win/hotvbs


 WatVBS20200517.zip(111KB)←HotVBS Ver.0.84以降用更新
下のスクリプト事例を、一括ダウンロードできます。


 以下は、VBScript の機能拡張用のオブジェクトで、通常はダウンロード不要です。
VBScript を使いこなしていく過程で、有益になるでしょう。

 BASP21(VBScript 拡張コンポーネント)
http://www.hi-ho.ne.jp/babaq/basp21.html

 WSH JScriptを使いこなそう 〜マウス操作〜
http://jscript.zouri.jp/Source/MouseCtrl.html
マウス操作用のDLL (MouseEmulatorDLL.zip) をダウンロードできます。

 Toas(VBScript 拡張コンポーネント)
http://www.tamasoft.co.jp/toas/

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

スクリプト事例ファイルの登録方法


タブ追加  ダウンロードしたHotVBS用スクリプト(WatVBS20200517.zip)は、下記の方法で登録します。
(更新の場合は、いったん HotVBS を終了させておいて、上書きして下さい。)

 左端の、既存のタブの部分(HotVBS の表示)で、マウス右クリックします。メニューが表示されるので、「タブを追加」を選択します。

 タブに、既存のタブと区分しやすい、適当な名前を付けます。(漢字を使うと、判別しやすいでしょう。)

ダウンロードしたファイルを登録  今度は、ツリー部でマウス右クリックしてメニューを表示します。「読込」を選択して、ダウンロードしたファイルを、登録します。

 タブの名前は、後からでも「タブの名前変更」で、わかり易く変更できます。

 「編集」ボタンを押して、ツリー部だけにして、ホットキーで実行するスクリプトを選択した状態にして、「最小化」します。
この状態にして、最小化します。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

HotVBS の基本

 HotVBS の使い方は、「説明/ライブラリ」の中で詳細に説明されています。私が特に抽出したものを、以下に記述します。

1.HotVBS オブジェクトと、Editor オブジェクトの使い分け
 (1).Editor.Past等は、スクリプトを起動したソフトを操作します。
   (スクリプトを起動したとき、アクティブだったソフト。エディタからHotVBSを起動させる場合は、対象が決まっているのでこちらを使う。)
 (2).HotVBS.Past等は、そのときアクティブなソフトを操作します。
   (HotVBS.Past等を実行した瞬間に、アクティブだったソフト。HotVBS側からソフトを起動させる場合は、こちらを使う。)

2.? を式(演算子の有る行)の右に置くと、実行時に変数値をモニタ部分に表示できます。

3.WScriptは、Windows Script Hostを、HotVBSがエミュレートしています。
 このため、WHS用スクリプトの、一部のプロパティやメソッドは使用できません。
 逆に、前処理するメリットで、変数に日本語が使えるようになっています! スクリプトの可読性が、飛躍的に向上します。


'	日本語変数の事例
Option Explicit
Dim 文字配列(1)
Dim カウンタ

文字配列(0) = "Hello, World!"
文字配列(1) = "こんにちは、世界!"

For カウンタ = 0 To 1
MsgBox 文字配列(カウンタ)
Next

Dim 数量
Dim 単価
Dim 金額
数量 = 5
単価 = 30
金額 = 単価 * 数量 ?
MsgBox "金額 = " & 金額 & " (円)"

'	HotVBSの情報を取得
Dim 取得内容

取得内容 = "■HotVBSのファイル名" & VbCrLf _
         & WScript.Name & VbCrLf & VbCrLf _
         & "■HotVBSのあるフォルダ・パス" & VbCrLf _
         & WScript.Path & VbCrLf & VbCrLf _
         & "■HotVBSのフルパス" & VbCrLf _
         & WScript.FullName & VbCrLf & VbCrLf _
         & "■HotVBSのバージョン" & VbCrLf _
         & WScript.Version

MsgBox 取得内容

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

クリップ・ボードに書き込むときの注意

この Web ページがクリップボードへアクセスすることを許可しますか?  VBScript で、クリップ・ボードからデータを取得することは問題無いのですが、逆に、IEオブジェクトを使ってクリップ・ボードに書き込むときは、下記のコーション画面が表示されます。

 この画面が、バックグラウンドに隠れていると、スクリプトが待ち状態で止まります。
 スクリプトが止まったときは、前面の画面を最小化して、ダイアログが出ていないか、確認しましょう。
 
この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

スクリプト事例と解説


注:
 サクラエディタ」と「oedit」は、デフォルトが、「無選択は、行コピー」、となっています。
 このため、

 サクラエディタの場合は、
「共通設定」→「編集」→「コピー」で、
「選択無しでコピーを可能にする」のチェックを外す。

 oedit の場合は、
「ツール」→「オプション」→「編集」で、
「選択範囲が無いときは、行全体をコピーする」のチェックを外す

と、以下のスクリプトの、自動全選択が機能します。


計算を実行してメモ帳に出力


Option Explicit
Dim 文字列
Dim WshShellオブジェクト

Set WshShellオブジェクト = CreateObject("WScript.Shell")

HotVBS.Sleep 500
WshShellオブジェクト.Run "notepad"
HotVBS.Sleep 500
WshShellオブジェクト.AppActivate "無題 - " 'タイトルが"無題 - "のウィンドウを探し、それを前面に表示させる。
'「メモ帳」の「メモ」が、古いバージョンは半角、現在は全角のため、「メモ帳」部分を外す。
HotVBS.Sleep 100

Do
  文字列 = InputBox("数式を入力してください。例:3*4" &  vbNewLine _
  & "終了は、空白のままOKして下さい。", "計算実行の例1")
  If 文字列 = "" Then Exit Do
  文字列 = 英数記号全→半変換(文字列) '全角→半角変換の関数の内容は、事例ファイルを参照下さい。

  HotVBS.Sleep 100
  WshShellオブジェクト.AppActivate "無題 - " 'タイトルが "無題 - " のウィンドウを、前面に表示
  HotVBS.Sleep 100

  文字列 = 文字列 & " = " & Eval(文字列)   & vbNewLine  ?
  ClipBoard.Text = 文字列
  HotVBS.Past
Loop 

'乱数
Dim 予測, 乱数
Randomize
乱数 = Int((10) * Rnd(1) + 1) ?
予測 = CInt(InputBox("当たりだと思う数字(1〜10)を入力してください。" &  vbNewLine _
   & "終了は、0 で OK して下さい。", "計算実行の例2" , 0))
Do Until 予測 = 0
   If 予測 = 乱数 Then
      MsgBox "おめでとう ! 当たりです。"
      Exit Do
   Else
      予測 = CInt(InputBox("残念 ! もう一度(1〜10)。", "計算実行の例2", 0))
   End If
Loop


 解説:
 InputBox 関数 は、ダイアログ ボックスにメッセージとテキスト ボックスを表示し、テキストが入力されるか、またはボタンがクリックされると、テキスト ボックスの内容を返します。

 InputBox(prompt[, title][, default][, xpos][, ypos][, helpfile, context])

 引数
prompt
ダイアログ ボックス内にメッセージとして表示する文字列を示す文字列式を指定します。引数 prompt に指定できる最大文字数は、1 バイト文字で約 1,024 文字です。ただし、使う文字の文字幅に依存します。引数 prompt に複数行を指定するには、改行する場所にキャリッジ リターン (Chr(13))、ライン フィード (Chr(10))、またはキャリッジ リターンとライン フィードの組み合わせ (Chr(13) & Chr(10)) を挿入してください。
title
ダイアログ ボックスのタイトル バーに表示する文字列を示す文字列式を指定します。引数 title を省略すると、タイトル バーにはアプリケーション名が表示されます。
default
ユーザーが何も入力しない場合に、テキスト ボックスに既定値として表示する文字列式を指定します。引数 default を省略すると、テキスト ボックスには何も表示されません。
xpos
画面の左端からダイアログ ボックスの左端までの水平方向の距離を twip 単位で示す数式を指定します。引数 xpos を省略すると、ダイアログ ボックスは水平方向に対して画面の中央の位置に配置されます。
ypos
画面の上端からダイアログ ボックスの上端までの垂直方向の距離を twip 単位で示す数式を指定します。引数 ypos を省略すると、ダイアログ ボックスは垂直方向に対して画面の上端から約 1/3 の位置に配置されます。
helpfile
ダイアログ ボックスに状況依存のヘルプを設定するために、使用するヘルプ ファイルの名前を示す文字列式を指定します。この引数は、表示するダイアログ ボックスの説明を、ヘルプを使って表示するときに指定します。引数 helpfile を指定した場合は、引数 context も指定する必要があります。
context
ヘルプ トピックに指定したコンテキスト番号を表す数式を指定します。引数 context を指定した場合は、引数 helpfile も指定する必要があります。

 引数 helpfile および引数 context を指定すると、ダイアログ ボックスに自動的に [ヘルプ] ボタンが追加されます。
 [OK] をクリックするか、または Enter キーを押すと、InputBox 関数はテキスト ボックスの内容を返します。[キャンセル] をクリックすると、InputBox 関数は長さ 0 の文字列 ("") を返します。


 AppActivate メソッド は、アプリケーション ウィンドウをアクティブにします。

 object.AppActivate title

 引数
object
WshShell オブジェクトです。
title
アクティブにするアプリケーションを指定します。この引数には、アプリケーションのタイトル バーに表示されるタイトル文字列か、アプリケーションのプロセス ID を指定できます。
 AppActivate メソッドは、プロシージャ コールが正常終了したかどうかを示すブール値を返します。このメソッドを呼び出すと、指定されたアプリケーションまたはウィンドウにフォーカスが移りますが、最大化と最小化には影響がありません。ユーザーがフォーカスを切り替えたりウィンドウを閉じたりすると、アクティブなアプリケーション ウィンドウからフォーカスが移ります。

 実行中の各アプリケーションのタイトル文字列を title と比較することで、どのアプリケーションがアクティブになるかが決まります。完全に一致するタイトルが見つからない場合、タイトル文字列の先頭が title と一致するアプリケーションがアクティブになります。そのようなアプリケーションが見つからない場合、タイトル文字列の最後が title と一致するアプリケーションがアクティブになります。名前が title と一致するアプリケーションのインスタンスがいくつかある場合、アクティブになるインスタンスは不定です。


 HotVBS.Past は、アクティブなエディタへ、クリップボードからテキストを貼り付け(選択範囲と置換)します。


 Rnd 関数 は、乱数を返します。
 初期シード値が変わらない限り、一連の Rnd 関数が返す乱数系列は同じになります。これは、連続する Rnd 関数が乱数系列の中の直前の乱数をシード値として、次の乱数をそれぞれ生成するためです。
 システム タイマーから取得した新しいシード値を使用して乱数ジェネレータを初期化するには、Rnd 関数を呼び出す前に、引数を指定せずに Randomize ステートメントを実行します。

 任意の範囲の整数の乱数を生成するには、次の式を使用します。
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
この式では、引数 upperbound には範囲の上限の値を指定し、引数 lowerbound には範囲の下限の値を指定します。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

DDwinで辞書引き

 処理のポイント:
1.WshShell オブジェクトExec メソッドを使って、アプリを起動。

'■経歴
' 2008/05/25:作成
' 2011/05/03:改行文字を除外

'■用途:
' アクティブ画面の、選択状態の文字列を、DDwinで、串刺し検索します。

'■使い方
' 辞書引きしたい範囲を、選択状態にして、
' ホットキー操作すると、DDwinで、串刺し検索します。
' 初回は、ホットキー(デフォルトは、[CTRL]+[Enter])が利かないことがあります。
' この場合は、再度ホットキーを押してみて下さい。

'■スクリプトの修正
'//(*1)実行ファイルのパス、ファイル名は、HotVBS の「編集」で、お使いのものと書き換えてください。
'//(*2)DDwin起動時のパラメータは、お使いの DDwin の設定に書き換えてください。
'//DDwin起動時のパラメータの書式
'// DDWIN.EXE 環境設定ファイル,二重起動の制限,グループ名,辞書番号,検索キーワード
'// 二重起動の制限 2…二重起動しない
'// グループ名 未指定なら前回使用したグループが開かれる。下の例は、グループ名は「主辞書」
'// 辞書番号 単独の辞書またはサブグループを指定する。G1…一つ目のグループに対して串刺し検索。下の画面例は、番号は「G1」
DDwinの辞書グループ

'■DDwinの設定
'このスクリプトを使う場合は、
'DDwin起動中に、DDwin側がクリップボードに反応しないように、
'DDwinの「ツール」→「オプション」→「他ソフトからの検索」で、
'「クリップボード経由自動検索」「行わない」にした方が良いでしょう。


'**********************************************************
Function DDwin(S)
   Dim objWshShell     ' WshShell オブジェクト
   Dim strCmdLine      ' 実行するコマンド

   Set objWshShell = CreateObject("WScript.Shell")
   If Err.Number = 0 Then
      '★DDwinのパスと、起動パラメータは、ご自身のものに修正して下さい。
      strCmdLine = "C:\Program Files\DDwin\ddwin.exe ,2,主辞書,G1," '←★(*1,*2)
      strCmdLine=strCmdLine & S '起動パラメータに、クリップボードから取得した単語を付加
      objWshShell.Exec(strCmdLine)
   Else
      MsgBox "エラー: " & Err.Description
   End If
   Set objWshShell = Nothing
End Function

'**********************************************************
'メイン
'**********************************************************
Dim クリップボードの文字列
ClipBoard.Clear                          'クリップボードをクリア
Editor.Copy                              '選択文字列をクリップボードへコピー
クリップボードの文字列 = ClipBoard.Text  '辞書引き対象の文字列

' 不要な両端スペース、改行を削除
クリップボードの文字列 = Trim(クリップボードの文字列) ?
クリップボードの文字列 = Replace(クリップボードの文字列, vbNewLine, "") ?
クリップボードの文字列 = 正規表現で置換(クリップボードの文字列, "{.*?}", "") ? '英辞郎のルビ除去

If クリップボードの文字列 <> "" Then
   DDwin(クリップボードの文字列)         '辞書引き
End If
ClipBoard.Undo                            'クリップボードを戻す

 解説:
 WshShell オブジェクトを作成すると、ローカルでのプログラム実行、レジストリ内容の操作、ショートカットの作成、システム フォルダへのアクセスなどを行うことができます。
 WshShell オブジェクトは Environment コレクションを提供します。このコレクションにより、WINDIR、PATH、PROMPT などの環境変数の操作が可能となります。

WshShellオブジェクトのメソッドとプロパティ
メソッド/プロパティ役割
RunExecプログラムの実行
AppActivate/SendKeysプログラムへのキー・ストロークの送信
SpecialFolders「デスクトップ」や「マイ ドキュメント」などの特殊フォルダのフルパスの取得
Environment/ExpandEnvironmentStrings環境変数の取得と設定
CreateShortcutショートカットの作成
LogEventアプリケーション・イベント・ログの作成
RegRead/RegWrite/RegDeleteレジストリの値の取得と設定
CurrentDirectoryカレント・ディレクトリの取得と変更
Popupダイアログ・ボックスの表示

 Exec メソッド
 WshScriptExec オブジェクトで、子コマンドシェルでアプリケーションを実行します。アプリケーションから StdIn/StdOut/StdErr ストリームにアクセスできます。

object.Exec(strCommand)

引数
 object :WshShell オブジェクトです。
 strCommand :スクリプトの実行に使用するコマンド ラインを示す文字列値です。コマンド プロンプトから入力する場合と全く同じコマンド ラインを指定します。

 Exec メソッドが返す WshScriptExec オブジェクトを使用すると、Exec メソッドを使って実行したスクリプトのステータス情報やエラー情報だけでなく、StdIn、StdOut、および StdErr チャンネルにもアクセスできます。Exec メソッドで実行できるのは、コマンド ラインのアプリケーションのみです。

 WSH 5.6以前の、古いWSH環境では、Runメソッドを使います。(Execは使ません。)
 Win95の場合は、下記のように書くと動きます。
objWshShell.Run(strCmdLine)

 Win95の場合、パスに空白があるとうまく動きません。DDwinを、\Program Files\ ではなく、\tool\ などのフォルダに登録すると、スクリプトが簡単になります。

 参考:
 RunメソッドとExecメソッドの比較
http://www.atmarkit.co.jp/fwin2k/operation/wsh05/wsh05_02.html

VBScript から Run メソッドでコマンドを実行するときの注意(括りに使う二重引用符)
http://blogs.sqlpassj.org/yamaken/archive/2004/08/16/3760.aspx

VBScript: 空白を含む行を二重引用符で囲む
http://blogs.sqlpassj.org/yamaken/archive/2007/05/15/23239.aspx


 アプリケーションの起動 (WSHテクニック集)
http://www.roy.hi-ho.ne.jp/mutaguchi/wsh/technic.htm

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

サクラエディタでgrep


*****************************************************************
■経歴
2010/04/03:作成

■用途:
テキスト・ファイルで用語集を作っておいて、他のソフトで作業中に、用語参照する。
アクティブ画面の、選択状態の文字列を、サクラ・エディタで、grep 検索します。

■使い方
参照したい用語を、選択状態にして、ホットキー操作すると、
サクラエディタでgrep検索します。

■スクリプトの修正
//(*1)実行ファイルのパス、ファイル名は、お使いのものと書き換えてください。
//(*2)検索方法は、用語の行頭のみから検索と、全体からの検索の2種類が有ります。
お使いの 状況に合せて、一方をコメント・アウトしてください。


'**********************************************************
Function SakuraGrep(単語)
   Dim objWshShell     ' WshShell オブジェクト
   Dim strCmdLine      ' 実行するコマンド

   Set objWshShell = CreateObject("WScript.Shell")
   If Err.Number = 0 Then
      strCmdLine = Chr(34) & "C:\tool\テキストエディタ\sakura.exe" & Chr(34) 'サクラ・エディタのパス

'      strCmdLine = strCmdLine & " -GREPMODE -GOPT=P1 -GCODE=99 -GFOLDER=" & Chr(34) '全体から検索 grep のコマンドライン
      strCmdLine = strCmdLine & " -GREPMODE -GOPT=RP1 -GCODE=99 -GFOLDER=" & Chr(34) '行頭のみ検索 grep のコマンドライン

      strCmdLine = strCmdLine & "C:\tool\HotVBS" & Chr(34) & " " & Chr(34) & "-GFILE=" & Chr(34) '用語ファイルのパス
      strCmdLine = strCmdLine & Chr(34) & "用語.txt" & " " & Chr(34) & " " & "-GKEY=" '用語ファイルのファイル名

'      strCmdLine = strCmdLine & Chr(34) & 単語  & Chr(34) '全体から検索。クリップボードから取得した単語を付加
      strCmdLine = strCmdLine & Chr(34) & "^" & 単語  & Chr(34) '行頭のみ検索。クリップボードから取得した単語を付加

      objWshShell.Exec(strCmdLine)
   Else
      MsgBox "エラー: " & Err.Description
   End If
   Set objWshShell = Nothing
End Function

'**********************************************************
'メイン
'**********************************************************
Dim sClipBoard
ClipBoard.Clear               'クリップボードをクリア
Editor.Copy                  '選択文字列をクリップボードへコピー
sClipBoard = ClipBoard.Text      '辞書引き対象の文字列
If sClipBoard <> "" Then
   SakuraGrep(sClipBoard)         '辞書引き
End If
ClipBoard.Undo               'クリップボードを戻す

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

テキストを「なでしこ」で実行

 処理のポイント:
1.WshShell オブジェクトRun メソッドを使って、アプリを起動。

'■経歴
' 作成:2008/12/23

'■用途:
' VerticalEditorなどの、アウトライン・プロセッサで、「なでしこ」用のプログラムを、
' ノード毎に作っている場合、表示しているノードのプログラムを「なでしこ」で実行する。
' アウトライン・プロセッサを使うと、複数の「なでしこ」プログラムを、ひとつのファイルで管理できます。
' アウトライン・プロセッサと「なでしこ」の連係のために、このツールを作りました。

'■使い方
' ★重要★アウトライン・プロセッサのノードの一行目には、
' 一文字目を#として、その右にプログラムの名前を記入して下さい。

' プロセッサの、「なでしこ」で実行させさせたいテキスト画面(ペイン)を、マウスク左クリックでアクティブにして」、
' ホットキー操作すると、「なでしこ」で実行します。


Option Explicit
Dim i, j, 全体行数, 文字列, なでしこタイトル, 開始行, タイトル文字数
Dim ファイルシステムオブジェクト, 行数, オブジェクト文字列
Dim 既存内容, 変換対象, デフォルトパス
Dim objWshShell     ' WshShell オブジェクト
Dim strCmdLine      ' 実行するコマンド


Sub 「なでしこ」で実行(文字列)

   '********************************************************
   デフォルトパス = "C:\Temp\"             '★★なでしこに渡すファイルのフォルダパスをここに記入★★

   '**************************************************************
   'テキストファイルを、なでしこ用に変換
   '1行ずつに分割
   ? 文字列
   文字列 = Split(文字列, VbCrLf)

   文字列(0) = Trim(文字列(0))                                       ?
   タイトル文字数 = Len(文字列(0)) - 1
   'トップ行の2文字目以降からを、なでしこタイトルと見なす
   なでしこタイトル = Trim(Right(文字列(0), タイトル文字数)) & ".nako"      ?

   '全体行数を取得
   全体行数 = UBound(文字列)                                        ?

   '最終行の処理
   文字列(全体行数) = RTrim(文字列(全体行数))                       ?
   While 文字列(全体行数) = "" 
      '空白行は除く
      全体行数 = 全体行数 - 1
      文字列(全体行数) = RTrim(文字列(全体行数))
   Wend 


   '***************************************************************
   ' 以下で、なでしこで実行します。
   'ファイルシステムオブジェクトオブジェクトを作成します
   Set ファイルシステムオブジェクト = CreateObject("scripting.FileSystemObject")
   Set オブジェクト文字列 = ファイルシステムオブジェクト.CreateTextFile(デフォルトパス & なでしこタイトル)

   For 行数 = 0 To 全体行数
      オブジェクト文字列.WriteLine(文字列(行数))
   Next
   オブジェクト文字列.CLOSE

   Set objWshShell = CreateObject("WScript.Shell")
   If Err.Number = 0 Then
      strCmdLine = Chr(34) & デフォルトパス & なでしこタイトル & Chr(34)
      objWshShell.run(strCmdLine)

   Else
      MsgBox "エラー: " & Err.Description
   End If

   'オブジェクトの破棄
   Set objWshShell = Nothing
   Set ファイルシステムオブジェクト = Nothing

End Sub


'****************☆☆☆☆☆☆☆☆**************************
'選択範囲を変換
既存内容 = HotVBS.ClipBoard       'バックアップ用
HotVBS.ClipBoard = ""   'クリップボードをクリア

HotVBS.Copy                       'エディタからクリップボードへコピー
変換対象 = HotVBS.ClipBoard       '変換対象
If 変換対象 = "" Then
   HotVBS.SelAll
   HotVBS.Copy
   変換対象 = HotVBS.ClipBoard   '変換対象
   HotVBS.Reset
End If

If 変換対象 <> "" Then
   Call 「なでしこ」で実行(変換対象)
End If
HotVBS.ClipBoard = 既存内容	'クリップボードを戻す


 解説:
 Run メソッドは、新しいプロセス内でプログラムを実行します。

 object.Run(strCommand, [intWindowStyle], [bWaitOnReturn])

object WshShell オブジェクトです。
strCommand 実行するコマンド ラインを示す文字列値です。
この引数には、実行可能ファイルに渡すべきパラメータをすべて含める必要があります。
intWindowStyle 省略可能です。
プログラムのウィンドウの外観を示す整数値です。
すべてのプログラムがこの情報を使用するわけではないので注意してください。
bWaitOnReturn 省略可能です。
スクリプト内の次のステートメントに進まずにプログラムの実行が終了するまでスクリプトを待機させるかどうかを示すブール値です。
bWaitOnReturn に TRUE を指定すると、プログラムの実行が終了するまでスクリプトの実行は中断され、Run メソッドはアプリケーションから返される任意のエラー コードを返します。
bWaitOnReturn に FALSE を指定すると、プログラムが開始すると Run メソッドは即座に復帰して自動的に 0 を返します (これをエラー コードとして解釈しないでください)。

解説
 Run メソッドは整数を返します。Run メソッドは新しい Windows プロセス内でプログラムの実行を開始します。スクリプト内の次の処理に進まずにプログラムの実行が終了するまでスクリプトを待機させることができます。これにより、スクリプトとプログラムを同期させて実行できます。
 引数 strCommand 内の環境変数は自動的に展開されます。ファイルの種類が対応するプログラムに正しく登録されている場合、その種類のファイルを指定して Run メソッドを呼び出すとプログラムが実行されます。
 たとえば、Word がコンピュータ システム上にインストールされている場合、*.doc ファイルを指定して Run を呼び出すと Word が起動し、指定したドキュメントがロードされます。

 次の表は、intWindowStyle に設定できる値を一覧したものです。

IntWindowStyle 内容
0 ウィンドウを非表示にし、別のウィンドウをアクティブにします。
1 ウィンドウをアクティブにして表示します。
ウィンドウが最小化または最大化されている場合は、元のサイズと位置に戻ります。
アプリケーションでウィンドウを最初に表示するときには、このフラグを指定してください。
2 ウィンドウをアクティブにし、最小化ウィンドウとして表示します。
3 ウィンドウをアクティブにし、最大化ウィンドウとして表示します。
4 ウィンドウを最新のサイズと位置で表示します。
アクティブなウィンドウは切り替わりません。
5 ウィンドウをアクティブにし、現在のサイズと位置で表示します。
6 指定したウィンドウを最小化し、Z オーダー上で次に上位となるウィンドウをアクティブにします。
7 ウィンドウを最小化ウィンドウとして表示します。
アクティブなウィンドウは切り替わりません。
8 ウィンドウを現在の状態で表示します。
アクティブなウィンドウは切り替わりません。
9 ウィンドウをアクティブにして表示します。
ウィンドウが最小化または最大化されている場合は、元のサイズと位置に戻ります。
アプリケーションで最小化ウィンドウを復元するときには、このフラグを指定してください。
10 アプリケーションを起動したプログラムの状態に基づいて、表示状態を設定します。

 使用例
 次のコードは、Microsoft のメモ帳を実行して実行中のスクリプトを開く例です。


Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "%windir%\notepad " & WScript.ScriptFullName

 次の VBScript コードも上記と同じ処理を実行する例ですが、ウィンドウの種類を指定し、ユーザーがメモ帳を終了するまで待機し、終了時にメモ帳から返されるエラー コードを保存する点が異なります。


Set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("notepad " & WScript.ScriptFullName, 1, true)


 使用例 2
 次の VBScript コードは、コマンド ウィンドウを開き、パスを C:\ に変更し、DIR コマンドを実行する例です。


Dim oShell
Set oShell = WScript.CreateObject ("WScript.Shell")
oShell.run "cmd /K CD C:\ & Dir"
Set oShell = Nothing


 CreateTextFile メソッドは、指定した名前のファイルを作成し、作成したファイルの読み取りまたは書き込みに使用できる TextStream オブジェクトを返します。

 object.CreateTextFile(filename[, overwrite[, unicode]])

object 必ず指定します。FileSystemObject オブジェクトまたは Folder オブジェクトの名前を指定します。
filename 必ず指定します。作成するファイルの名前を文字列式で指定します。
overwrite 省略可能です。
既存ファイルの場合に上書きするかどうかを示すブール値を指定します。
上書きする場合は真 (true) を、上書きしない場合は偽 (false) を指定します。
省略した場合は、既存ファイルは上書きされません。
unicode 省略可能です。
Unicode ファイルと ASCII ファイルのどちらを作成するかを示すブール値を指定します。
Unicode ファイルを作成する場合は真 (true) を、ASCII ファイルを作成する場合は偽 (false) を指定します。
省略した場合は、ASCII ファイルが作成されます。

 解説
 次のコードは、CreateTextFile メソッドを使ってテキスト ファイルを作成する例です。


[JScript]
var fso = new ActiveXObject("Scripting.FileSystemObject");
var a = fso.CreateTextFile("c:\\testfile.txt", true);
a.WriteLine("これはテストです。");
a.Close();


[VBScript]
Sub CreateAfile
   Dim fso, MyFile
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set MyFile = fso.CreateTextFile("c:\testfile.txt", True)
   MyFile.WriteLine("これはテストです。")
   MyFile.Close
End Sub

 引数
 overwrite に偽 (false) を指定した場合、または省略した場合、引数 filename に既存のファイル名を指定するとエラーが発生します。


 WriteLine メソッドは、指定した文字列と改行文字を TextStream ファイルに書き込みます。

 object.WriteLine([string])

object 必ず指定します。TextStream オブジェクトの名前を指定します。
string 省略可能です。ファイルに書き込むテキストを指定します。
省略した場合は、改行文字だけがファイルに書き込まれます。

 解説
 次のコードは、WriteLine メソッドの使用例です。


[JScript]
var fso, f;
fso = new ActiveXObject("Scripting.FileSystemObject");
f = fso.CreateTextFile("c:\\testfile.txt", true);
f.WriteLine("これはテストです。");
f.Close();


[VBScript]
Function WriteLineToFile
   Const ForReading = 1, ForWriting = 2
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("c:\testfile.txt", ForWriting, True)
   f.WriteLine "Hello world!" 
   f.WriteLine "これはテストです。"
   Set f = fso.OpenTextFile("c:\testfile.txt", ForReading)
   WriteLineToFile = f.ReadAll
End Function


 TextStream オブジェクトは、ファイルへのシーケンシャル アクセスを行うオブジェクトです。

 TextStream.{property | method( )}

 引数
 property と引数 method には、TextStream オブジェクトに関連付けられている任意のプロパティおよびメソッドを指定できます。
 実際に使用する場合は、TextStream の部分は TextStream オブジェクトを表す変数名で置き換えることになります。
 TextStream オブジェクトは、FileSystemObject オブジェクトから取得します。

 解説
 次のコードは、変数 a が、CreateTextFile メソッドによって取得された FileSystemObject オブジェクトの TextStream オブジェクトを示す例です。


[JScript]
var fso = new ActiveXObject("Scripting.FileSystemObject");
var a = fso.CreateTextFile("c:\\testfile.txt", true);
a.WriteLine("テストです。");
a.Close();


[VBScript]
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile= fso.CreateTextFile("c:\testfile.txt", True)
MyFile.WriteLine("テストです。")
MyFile.Close

 WriteLine および Close は、TextStream オブジェクトのメソッドです。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


WScriptをHotVBSに

 処理のポイント:
1.正規表現 RegExp を使って、文字列を置換。

 HotVBS Ver 0.6 から、WScript用のスクリプトも、ほとんどそのまま動くようになりました。
 したがって、ここで紹介するスクリプトを、今後使う必要はないでしょう。
 正規表現を使った、文字列置換のサンプルという意味で、掲示を継続します。



'   WScriptをHotVBSに

'■内容:
'WScript用に書かれたスクリプトを、HotVBS用に、自動で書き換えます。

'世の中では、便利なVBスクリプトが、多数公開されています。
'気に入ったものがあれば、HotVBS に登録しておくと、編集・活用に便利です。

'スクリプトを、HotVBSに貼り込んで登録すると、
'VBスクリプトの管理・編集・起動が容易になります。
'漢字変数を使って、解読しやすく書き直すことも含めて、HotVBSの強力な開発環境を利用できます。

'ところが、公開されているスクリプトには、
'wscript.exe で動かすことを前提とした記述のものが、少なからず存在して、
'これらは、そのままでは HotVBS からでは、動きません。

'具体的には、スクリプトの中に「WScript.」の記述があるものです。
'そんなときに、これを使って変換できます。


'■使い方:
'@.公開されているスクリプト(拡張子 .vbs でエクスプローラから起動できるもの)を、
'単独で動作させて、その結果を確認します。
'A.テキスト・エディタで、そのスクリプトを開きます。
'B.このスクリプトを使って、HotVBS用に変換します。
'C.HotVBSに、新しい項目を作って、エディタから貼付けて、登録します。
'D.HotVBSから「実行」して、同じ動作になることを確認します。
'
'■経歴:
'   作成:2007/10/13


Option Explicit
Dim WScript用, HotVBS用
Dim i, 文字列, 全体行数
Dim 既存内容, 変換対象

'******************************************************
Function WScriptをHotVBSに(文字列)
'******************************************************

   文字列 = 正規表現で置換(文字列, "(WScript.CreateObject\(\x22.+?\x22),.+?\)", "$1)")
   '            "は16進ASCII文字コードで表現

   '次の2つは、削除できないので、置換の対象から外すため、いったん退避させます。
   文字列 = Replace(文字列, "WScript.Shell", "スクリプトシェル退避", 1, - 1, 1)
   文字列 = Replace(文字列, "WScript.Network", "スクリプトネットワーク退避", 1, - 1, 1)
'   1番目の位置からテキスト モードで比較して、置換します。
   
   '置換のための、変換対応リストです。
   WScript用 = Array("WScript.Echo", "WScript.Quit", "WScript.Sleep", "WScript.")
   HotVBS用 = Array("MsgBox", "HotVBS.Quit", "HotVBS.Sleep", "")

   ?  UBound(WScript用)
   For i = 0 To UBound(WScript用)
      '1番目の位置からテキスト モードで比較して、置換します。
      文字列 = Replace(文字列, WScript用(i), HotVBS用(i), 1, - 1, 1)
   Next
   
   '退避させておいた2つを、戻します。
   文字列 = Replace(文字列, "スクリプトシェル退避", "WScript.Shell")
   文字列 = Replace(文字列, "スクリプトネットワーク退避", "WScript.Network")

   WScriptをHotVBSに = 文字列
End Function


'****************************************************
Function 正規表現で置換(置換対象, 置換前, 置換後)
'****************************************************
   Dim 正規表現                         ' 変数を作成します。
   Set 正規表現 = New RegExp            ' 正規表現を作成します。
   正規表現.Pattern = 置換前            ' パターンを設定します。
   正規表現.IgnoreCase = True           ' 大文字と小文字を区別しないように設定します。
   正規表現.Global = True               ' 一致するもの全てを対象とするように設定します。

   正規表現で置換 = 正規表現.Replace(置換対象, 置換後)   ' 置換します。
   Set 正規表現 = Nothing
End Function


'******************************************************
'★★★★    メイン処理    ★★★★
'******************************************************
'選択範囲を変換
既存内容 = HotVBS.ClipBoard         'クリップボードの内容をバックアップ
HotVBS.ClipBoard = ""               'クリップボードをクリア

HotVBS.Copy                         'エディタからクリップボードへコピー
変換対象 = HotVBS.ClipBoard         'エディタから取得したテキストを、変数「変換対象」に格納

If 変換対象 = "" Then
   HotVBS.SelAll                   '変換対象を指定していない場合は、全選択
   HotVBS.Copy
   変換対象 = HotVBS.ClipBoard     '全選択してコピーした内容を、変数「変換対象」に格納
End If

If 変換対象 <> "" Then              '変数「変換対象」に文字列が入った場合に、関数で変換
   変換対象 = WScriptをHotVBSに(変換対象)
   HotVBS.ClipBoard = 変換対象     '関数を使って変換した結果を、クリップボードに戻す
   HotVBS.Past                     'テキストエディタに、貼付ける
End If

HotVBS.ClipBoard = 既存内容         'HotVBS処理前のクリップボードの内容を戻す

 解説:
 Replace 関数は、指定された文字列の一部を、別の文字列で指定された回数分で置換した文字列を返します。

 Replace(expression, find, replacewith[, start[, count[, compare]]])

expression 必ず指定します。置換する文字列を含む文字列式を指定します
find 必ず指定します。検索する文字列を指定します。
replacewith 必ず指定します。置換する文字列を指定します。
start 省略可能です。
引数 expression 内の内部文字列の検索開始位置を指定します。count と共に使用してください。
count 省略可能です。
置換する文字列数(指定文字の回数)を指定します。
この引数を省略すると、既定値の -1 が使用され、すべての候補が置換されます。start と共に使用してください。
compare 省略可能です。
文字列式を評価するときに使用する文字列比較のモードを表す数値を指定します。
設定する値については、「設定値」を参照してください。
この引数を省略すると、既定値の 0 が使用され、バイナリ モードで比較が行われます。

変換後 = Replace("AAAAAAAAAA", "AA", "abc", 3, 2) ?
変換後→abcabcAAAA


 Regular Expression オブジェクトは、簡単な正規表現をサポートします。

 Pattern プロパティは、検索される正規表現のパターンを設定します。値の取得も可能です。

 object.Pattern [= "searchstring"]

object 必ず指定します。RegExp オブジェクト変数を指定します。

searchstring 省略可能です。検索される文字列式を指定します。Settings セクションの表で定義された正規表現の文字をどれでも使用できます。

設定値
 正規表現のパターンの記述には、特別な文字およびエスケープ シーケンスが使用されます。 正規表現の項を参照下さい。


 IgnoreCase プロパティは、パターン検索で大文字と小文字を区別するかどうかを示すブール (Boolean) 値を設定します。
 False(既定値):検索するときに大文字と小文字を区別する
  VBScript の既定では、大文字と小文字を区別することに、要注意です。
 True:区別しない

 object.IgnoreCase [= True | False ]

 引数 object には、RegExp オブジェクトを指定します。


 Global プロパティは、検索文字列全体についてのパターンとの一致を検索するか、最初の一致だけを検索するかを示すブール (Boolean) 値を設定します。
object.Global [= True | False ]
 引数 object には、RegExp オブジェクトを指定します。
 Global プロパティの値は、文字列全体に検索が適用されると True、適用されないと False です。
 既定値は False(文字列全体に検索を適用しない) です。
  既定値(False) のままだと、最初に ヒット したところだけが、検索および置換の対象になります。

 次のコードは、Global プロパティの使用例です。
Function RegExpTest(patrn, strng)
   Dim regEx, Match, Matches   ' 変数を作成します。
   Set regEx = New RegExp   ' 正規表現を作成します。
   regEx.Pattern = patrn   ' パターンを設定します。
   regEx.IgnoreCase = True   ' 大文字と小文字を区別しないように設定します。
   regEx.Global = True   ' 文字列全体を検索するように設定します。
   Set Matches = regEx.Execute(strng)   ' 検索を実行します。
   For Each Match in Matches   ' Matches コレクションに対して繰り返し処理を行います。
RetStr = RetStr & "一致する文字列が見つかった位置は、"
RetStr = RetStr & Match.FirstIndex & " です。一致した文字列は、"
RetStr = RetStr & Match.Value & " です。" & vbCRLF
   Next
   RegExpTest = RetStr
End Function
MsgBox(RegExpTest("is.", "IS1 is2 IS3 is4"))

 Test メソッドは、指定された文字列を正規表現で検索し、パターンに一致する文字列が検索されたかどうかを示すブール (Boolean) 値を返します。
 パターンに一致する文字列が見つかると True、見つからないと False を返します。

 object.Test(string)

object 必ず指定します。RegExp オブジェクトの名前を指定します。

string 必ず指定します。正規表現による検索の対象となるテキスト文字列を指定します。

http://technet.microsoft.com/ja-jp/magazine/2008.05.heyscriptingguy.aspx


 Array 関数は、配列が格納されたバリアント型 (Variant) の値を返します。

 Array(arglist)

 引数 arglist には、値のリストをカンマ (,) で区切って指定します。指定した値は、バリアント型 (Variant) に格納される配列の各要素に代入されます。引数 arglist を指定しない場合は、長さ 0 の配列が作成されます。
 配列のインデックスは 0 から始まります。したがって、作成された要素のインデックスは 0 〜 (size - 1) となります。


 UBound 関数は、配列で指定した次元で使用できる、インデックス番号の最大値を返します。

 UBound(arrayname[, dimension])

arrayname 必ず指定します。配列変数の名前を指定します。変数の標準的な名前付け規則に従って付けます。

dimension 省略可能です。インデックス番号の最大値を調べる配列の次元を示す整数を指定します。最初の次元なら 1、2 番目の次元なら 2 というように指定します。引数 dimension を省略すると、1 が使用されます。


この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


行末空白削除して連続空行を1行に

 処理のポイント:
1.対象のテキスト・データを、Split を使って、一行ずつに分割。
2.RTrim で、行末の空白を削除。
3.一行ずつのデータを、改行コード(VbCrLf)を付けて、結合。


'   行末空白削除して連続空行を1行に

'■用途:
'   ホームページの内容をテキスト・コピーしたりるすと、
'   行末や、行間に、不要な空白ができます。
'   これらを削除して、見やすく整形します。

'■経歴
'   2007/09/09:作成
'   2007/10/06:変数を漢字化
'   2007/11/02:HotVBS新ライブラリに変更
'   2008/01/13:テキスト無しを考慮


Option Explicit
Dim i, 文字列, 全体行数
Dim 変換対象

'******************************************************
Function 行末空白削除して連続空行を1行に(文字列)
'******************************************************
      '1行ずつに分割
   文字列 = Split(文字列, VbCrLf)
   
      '全体行数を取得
   全体行数 = UBound(文字列)                    ?
   
      '最終行の処理
   文字列(全体行数) = RTrim(文字列(全体行数))   ?
   While 文字列(全体行数) = "" 
      '空白行は除く
      全体行数 = 全体行数 - 1                  ?
      文字列(全体行数) = RTrim(文字列(全体行数))
   Wend 
   
      '初めから順に、空白でない最後の行まで
   For i = 0 To 全体行数
      文字列(i) = RTrim(文字列(i))              ?
      If i = 0 Then
         '1行目は、そのまま生かす
         行末空白削除して連続空行を1行に = 行末空白削除して連続空行を1行に & 文字列(i) & VbCrLf
      Else
         '2行目以降は、
         If Len(文字列(i - 1)) <> 0 Or Len(文字列(i)) <> 0 Then 
            '連続した空行でないときのみ、出力
            行末空白削除して連続空行を1行に = 行末空白削除して連続空行を1行に & 文字列(i) & VbCrLf
         End If
      End If
   Next
End Function


'******************************************************
'★★★★    メイン処理    ★★★★
'******************************************************
'選択範囲を変換

ClipBoard.Clear               'クリップボードをクリア

Editor.Copy                         'エディタからクリップボードへコピー
変換対象 = ClipBoard.Text    ?     'エディタから取得したテキストを、変数「変換対象」に格納


If 変換対象 = "" Then
   Editor.SelectAll                   '変換対象を指定していない場合は、全選択
   Editor.Copy
   変換対象 = ClipBoard.Text   ?  '全選択してコピーした内容を、変数「変換対象」に格納
End If

If 変換対象 <> "" Then              '変数「変換対象」に文字列が入った場合に、関数で変換
   変換対象 = 行末空白削除して連続空行を1行に(変換対象)
   ClipBoard.Text = 変換対象     '関数を使って変換した結果を、クリップボードに戻す
   Editor.Past                     'テキストエディタに、貼付ける
End If

ClipBoard.Undo	'クリップボードを戻す


 解説:
 Split 関数は、各要素ごとに区切られた文字列からゼロ ベースの 1 次元配列を作成し、返します。
 インデックス番号は、0から始まる点に、要注意です。

 Split(expression[, delimiter[, count[, compare]]])
expression 必ず指定します。文字列と区切り文字を含んだ文字列式を指定します。引数 expression が長さ 0 の文字列 ("") である場合、Split 関数は、要素もデータもない空の配列を返します。

delimiter 省略可能です。文字列の区切りを識別する文字を指定します。引数 delimiter を省略すると、区切り文字にスペース (" ") が使用されます。引数 delimiter が長さ 0 の文字列 ("") である場合は、引数 expression 全体の文字列を含む単一の要素の配列を返します。

count 省略可能です。返す配列の要素数を指定します。-1 を指定すると、すべての文字列を含んだ配列を返します。

compare 省略可能です。文字列式を評価するときに使用する文字列比較のモードを表す数値を指定します。設定する値については、次の「設定値」を参照してください。

 設定値:引数 compare の設定値は次のとおりです。
内容
0バイナリ モードで比較を行います。(大文字小文字を区分する)
1テキスト モードで比較を行います。

 Split 関数を使って文字列から配列を返す例です。
関数は区切り文字の比較をテキスト モードで行い、各要素の文字列全体を返します。

Dim MyString, MyArray, Msg
MyString = "VBScriptXisXfun!"
MyArray = Split(MyString, "x", -1, 1)
' MyArray(0) は、"VBScript" です。
' MyArray(1) は、"is" です。
' MyArray(2) は、"fun!" です。
Msg = MyArray(0) & " " & MyArray(1)
Msg = Msg   & " " & MyArray(2)
MsgBox Msg

 文字列の定数
 文字コードを表す定数は、あらかじめ VBScript に組み込まれているので、使用前に定義する必要はありません。
 コード中のどこでも、対応する値の代わりに使用することができます。
定数内容
vbCrChr(13)キャリッジ リターン文字。
VbCrLfChr(13) & Chr(10)キャリッジ リターンとライン フィードの組み合わせ。
vbLfChr(10)ライン フィード文字。
vbNewLineChr(13)、Chr(10) または Chr(10)プラットフォームで指定した改行文字。現在のプラットフォームに適切ないずれかを使用します。
vbNullCharChr(0)値 0 を持つ文字列。
vbNullString値 0 を持つ文字列長さ 0 の文字列 ("") とは異なります。外部プロシージャを呼び出す場合に使用します。
vbTabChr(9)タブ文字 (横)。


 LTrim 関数、RTrim 関数、Trim 関数
 指定された文字列から先頭のスペース (LTrim) または末尾のスペース (RTrim)、あるいは先頭と末尾の両方のスペース (Trim) を削除した文字列を返します。

LTrim(string)
RTrim(string)
Trim(string)
引数 string には、任意の文字列式を指定します。引数 string に Null 値が含まれている場合は、Null 値を返します。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

半角英字の1文字目を大文字に、以下を小文字に


■経歴
2010/07/24:作成

■用途:
半角英文字の文字列に対して、選択部分の1文字目を大文字に、以下を小文字に変換します。
例:ABC→Abc、abc→Abc

■使い方
変換したい範囲を、選択状態にして、ホットキー操作します。


Option Explicit

Dim 文字列
Dim 大文字
Dim 小文字

Function 変換(文字列)
	大文字 = UCase(Left(文字列, 1))
	小文字 = LCase(Right(文字列, Len(文字列) - 1))
	変換 = 大文字 & 小文字
End Function


'メイン
ClipBoard.Clear()	'クリア
Editor.Copy()	'コピー
文字列 = ClipBoard.Text
If 文字列 <> "" Then
	文字列 = 変換(文字列)
	ClipBoard.Text = 文字列
	Editor.Past()
End If

ClipBoard.Undo()	'戻す

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


カナ→ローマ字変換(Excelセル選択範囲一括:本命)

 処理のポイント:
1.Replace を使って、文字列を置換。
2.GetObject を使って、起動中の Excel を操作して、Excel の機能で、選択中のセル範囲のデータをコピーしたり、貼り付けしたり。

カナ→ローマ字変換表→kana2romaji.xls
  このローマ字表は、ヘボン式・英国式・その他の表記を参考に、渡辺真が編纂したものです。
  このクレジット(credit:著作権者表記)を付記していただければ、ことわりなく、転載、改変など、随意にしていただいてかまいません。


'	カナ→ローマ字変換(セル範囲一括)
'*****************************************************************
'■経歴
'	作成 2007/09/22:テキスト・エディタ用とExcel用を統合
'	変更 2007/09/22 夜:Excelの場合、セルの選択範囲を一括して変換するように変更。
'	変更 2007/09/23:Excelのオブジェクトの取得を、GetObject 一本に変更。
'	変更 2007/10/06:変数の漢字化。
	
'■用途:
'	Excelの選択セル範囲や、アクティブなテキスト上の「カナ(全角・半角)」を、
'	ヘボン式に準拠した、ローマ字表記に変換します。

'	例えば、カナ表記の氏名を、ローマ字表記に変更する場合などに、使います。

'■使い方
'	Excelの場合は、変換対象のセル範囲を選択状態にして、
'	テキスト・エディタの場合も、変換したい範囲を、選択状態にして、
'	ホットキー操作すると、カナ→ローマ字変換します。

'	テキスト・エディタの場合は、「Excelが起動していない状態」ならば、
'	変換対象ファイルを、マウスク左クリックでアクティブにして、
'	ホットキー操作すると、自動で全選択して、カナ→ローマ字変換します。

'****************************************************************

Option Explicit

'**********************************************************
'★★★★カナ→ローマ字変換の関数★★★★
Function カナ→ローマ字変換(文字列)
'**********************************************************
Dim カナ , ローマ字, i, j, k

'選択文字列変換(複数行も可)

	'0〜1549
	'このローマ字表は、ヘボン式・英国式・その他の表記を参考に、
	'渡辺真が編纂したものです。
	'このクレジットを付記していただければ、ことわりなく、転載、改変など、随意にしていただいてかまいません。
	カナ = Array("ッビャー", "ッビェー", "ッビョー", "ッビュー", "ッディー", "ッドゥー", "ッデュー", "ッグァー", "ッグェー", "ッグィー", "ッグォー", "ッギャー", "ッギェー", "ッギョー", "ッギュー", "ッジャー", "ッジェー", "ッジョー", "ッジュー", "ッンバー", "ッンベー", "ッンビー", "ッンボー", "ッンブー", "ッンパー", "ッンペー", "ッンピー", "ッンポー", "ッンプー", "ッピャー", "ッピェー", "ッピョー", "ッピュー", "ッヴァー", "ッヴェー", "ッヴィー", "ッヴォー", "ッヴョー", "ッヴュー", "ッズィー", "ッヂャー", "ッヂョー", "ッヂュー", "ッファー", "ッフェー", "ッフィー", "ッフォー", "ッフャー", "ッフョー", "ッフュー", "ッヒャー", "ッヒェー", "ッヒョー", "ッヒュー", "ックァー", "ックェー", "ックィー", "ックォー", "ッキャー", "ッキェー", "ッキョー", "ッキュー", "ッンマー", "ッンメー", "ッンミー", "ッンモー", "ッンムー", "ッミャー", "ッミェー", "ッミョー", "ッミュー", "ッンアー", "ッンエー", "ッンイー", "ッンナー", "ッンネー", "ッンニー", "ッンノー", "ッンヌー", "ッンオー", "ッンウー", "ッニャー", "ッニェー", "ッニェー", "ッニョー", "ッニュー", "ッリャー", "ッリェー", "ッリョー", "ッリュー", "ッシャー", "ッシェー", "ッシェー", "ッショー", "ッシュー", "ッスィー", "ッチャー", "ッチェー", "ッチェー", "ッチョー", "ッチュー", "ッティー", "ッオオー", "ッオウー", "ッツァー", "ッツェー", "ッツィー", "ッツォー", "ットゥー", "ッテュー", "ッウェー", "ッウィー", "ッウォー", "ッイェー", "ッバー", "ッベー", "ッビー", "ッボー", "ッブー", "ッビャ", "ッビェ", "ッビョ", "ッビュ", "ビャー", "ビェー", "ビョー", "ビュー", "ッダー", "ッデー", "ッディ", "ッドー", "ッドゥ", "ッデュ", "ッヅー", "ディー", "ドゥー", "デュー", "ッガー", "ッゲー", "ッギー", "ッゴー", "ッグー", "ッグァ", "ッグェ", "ッグィ", "ッグォ", "ッギャ", "ッギェ", "ッギョ", "ッギュ", "グァー", "グェー", "グィー", "グォー", "ギャー", "ギェー", "ギョー", "ギュー", "ジャー", "ジェー", "ッジャ", "ッジェ", "ッジー", "ッジョ", "ッジュ", "ジョー", "ジュー", "ンバー", "ンベー", "ンビー", "ンボー", "ンブー", "ッンバ", "ッンベ", "ッンビ", "ッンボ", "ッンブ", "ッンパ", "ッンペ", "ッンピ", "ッンポ", "ッンプ", "ンパー", "ンペー", "ンピー", "ンポー", "ンプー", "ッパー", "ッペー", "ッピー", "ッポー", "ップー", "ッピャ", "ッピェ", "ッピョ", "ッピュ", "ピャー", "ピェー", "ピョー", "ピュー", "ヴァー", "ヴェー", "ヴィー", "ヴォー", "ッヴァ", "ッヴェ", "ッヴィ", "ッヴォ", "ッヴー", "ッヴョ", "ッヴュ", "ヴョー", "ヴュー", "ズィー", "ヂャー", "ヂョー", "ヂュー", "ッザー", "ッゼー", "ッズィ", "ッヂー", "ッゾー", "ッズー", "ッヂャ", "ッヂョ", "ッヂュ", "チャー", "チェー", "チェー", "チョー", "チュー", "ファー", "フェー", "ッファ", "ッフェ", "ッフィ", "ッフォ", "ッフー", "ッフャ", "ッフョ", "ッフュ", "フィー", "フォー", "フャー", "フョー", "フュー", "ッハー", "ッヘー", "ッヒー", "ッホー", "ッヒャ", "ッヒェ", "ッヒョ", "ッヒュ", "ヒャー", "ヒェー", "ヒョー", "ヒュー", "ッカー", "ッケー", "ッキー", "ッコー", "ックー", "ックァ", "ックェ", "ックィ", "ックォ", "ッキャ", "ッキェ", "ッキョ", "ッキュ", "クァー", "クェー", "クィー", "クォー", "キャー", "キェー", "キョー", "キュー", "ンマー", "ッマー", "ンメー", "ッメー", "ンミー", "ッミー", "ッンマ", "ッンメ", "ッンミ", "ッンモ", "ッンム", "ンモー", "ッモー", "ンムー", "ッムー", "ッミャ", "ッミェ", "ッミョ", "ッミュ", "ミャー", "ミェー", "ミョー", "ミュー", "ンアー", "ッナー", "ンエー", "ッネー", "ンイー", "ッニー", "ッンア", "ンナー", "ッンエ", "ンネー", "ッンイ", "ンニー", "ッンナ", "ッンネ", "ッンニ", "ッンノ", "ッンヌ", "ッンオ", "ンノー", "ッンウ", "ンヌー", "ンオー", "ッノー", "ンウー", "ッヌー", "ッニャ", "ッニェ", "ッニョ", "ッニュ", "ニャー", "ニェー", "ニョー", "ニュー", "オオー", "オウー", "ッラー", "ッレー", "ッリー", "ッロー", "ッルー", "ッリャ", "ッリェ", "ッリョ", "ッリュ", "リャー", "リェー", "リョー", "リュー", "シャー", "シェー", "ショー", "シュー", "スィー", "ッサー", "ッセー", "ッシャ", "ッシェ", "ッシー", "ッショ", "ッシュ", "ッスィ", "ッソー", "ッスー", "ッチャ", "ッチェ", "ッチェ", "ッチー", "ッチョ", "ッチュ", "ティー", "ツァー", "ツェー", "ツィー", "ツォー", "ッアー", "ッター", "ッエー", "ッテー", "ッティ", "ッイー", "ッオオ", "ッオウ", "ッオー", "ットー", "ッツァ", "ッツェ", "ッツィ", "ッツォ", "ッツー", "ットゥ", "ッウー", "ッテュ", "トゥー", "テュー", "ウェー", "ウィー", "ウォー", "ッワー", "ッウェ", "ッヱー", "ッウィ", "ッヰー", "ッウォ", "ッヲー", "イェー", "イェー", "ッヤー", "ッイェ", "ッイェ", "ッヨー", "ッユー", "バー", "ッバ", "ッベ", "ッビ", "ッボ", "ッブ", "ベー", "ビー", "ボー", "ブー", "ビャ", "ビェ", "ビィ", "ビョ", "ビュ", "ダー", "ッダ", "ッデ", "ッド", "ッヅ", "デー", "ディ", "ドー", "ドゥ", "ドォ", "デャ", "デョ", "デュ", "ヅー", "ガー", "ゲー", "ッガ", "ッゲ", "ッギ", "ッゴ", "ッグ", "ギー", "ゴー", "グー", "グァ", "グェ", "グィ", "グォ", "ギャ", "ギェ", "ギィ", "ギョ", "ギュ", "ジャ", "ジェ", "ジー", "ッジ", "ジョ", "ジュ", "ジィ", "ンバ", "ンベ", "ンビ", "ンボ", "ンブ", "ンパ", "ンペ", "ンピ", "ンポ", "ンプ", "パー", "ペー", "ピー", "ポー", "ッパ", "ッペ", "ッピ", "ッポ", "ップ", "プー", "ピャ", "ピェ", "ピィ", "ピョ", "ピュ", "ヴァ", "ヴェ", "ヴィ", "ヴォ", "ヴー", "ッヴ", "ヴャ", "ヴョ", "ヴュ", "ザー", "ゼー", "ズィ", "ヂー", "ゾー", "ズー", "ヂャ", "ヂョ", "ヂュ", "ッザ", "ッゼ", "ッヂ", "ッゾ", "ッズ", "アー", "チャ", "チェ", "チー", "チョ", "チュ", "エー", "ファ", "フェ", "ッフ", "フィ", "フォ", "フー", "フゥ", "フャ", "フョ", "フュ", "ハー", "ヘー", "ッハ", "ッヘ", "ッヒ", "ッホ", "ヒー", "ホー", "ヒャ", "ヒェ", "ヒィ", "ヒョ", "ヒュ", "イー", "カー", "ケー", "キー", "ッカ", "ッケ", "ッキ", "ッコ", "ック", "コー", "クー", "クァ", "クェ", "クィ", "クォ", "キャ", "キェ", "キィ", "キョ", "キュ", "マー", "メー", "ミー", "ンマ", "ッマ", "ンメ", "ッメ", "ンミ", "ッミ", "ンモ", "ッモ", "ンム", "ッム", "モー", "ムー", "ミャ", "ミェ", "ミィ", "ミョ", "ミュ", "ナー", "ネー", "ニー", "ンア", "ッナ", "ンエ", "ッネ", "ンイ", "ッニ", "ンナ", "ンネ", "ンニ", "ンノ", "ンヌ", "ンオ", "ッノ", "ンウ", "ッヌ", "ノー", "ヌー", "ニャ", "ニェ", "ニィ", "ニョ", "ニュ", "オオ", "オウ", "オー", "クャ", "クョ", "クュ", "ラー", "レー", "リー", "ロー", "ッラ", "ッレ", "ッリ", "ッロ", "ッル", "ルー", "リャ", "リェ", "リィ", "リョ", "リュ", "サー", "セー", "シャ", "シェ", "シー", "ショ", "シュ", "スィ", "ソー", "ッサ", "ッセ", "ッシ", "ッソ", "ッス", "スー", "スァ", "スォ", "スゥ", "ター", "ッチ", "テー", "ティ", "トー", "ツァ", "ツェ", "ツィ", "ツォ", "ツー", "ッア", "ッタ", "ッエ", "ッテ", "ッイ", "ッオ", "ット", "ッツ", "ッウ", "トゥ", "テョ", "テュ", "ウー", "ワー", "ウェ", "ヱー", "ウィ", "ヰー", "ウォ", "ヲー", "ッワ", "ッヱ", "ッヰ", "ッヲ", "ヤー", "イェ", "ヨー", "ユー", "ッヤ", "ッヨ", "ッユ", "バ", "ベ", "ビ", "ボ", "ブ", "ダ", "デ", "ド", "ヅ", "ガ", "ゲ", "ギ", "ゴ", "グ", "ジ", "パ", "ペ", "ピ", "ポ", "プ", "ヴ", "ザ", "ゼ", "ヂ", "ゾ", "ズ", "ー", "ア", "ァ", "チ", "エ", "ェ", "フ", "ハ", "ヘ", "ヒ", "ホ", "イ", "ィ", "カ", "ケ", "キ", "コ", "ク", "マ", "メ", "ミ", "モ", "ム", "ン", "ナ", "ネ", "ニ", "ノ", "ヌ", "オ", "ォ", "ラ", "レ", "リ", "ロ", "ル", "サ", "セ", "シ", "ソ", "ス", "ッ", "タ", "テ", "ト", "ツ", "ウ", "ゥ", "ワ", "ヱ", "ヰ", "ヲ", "ヤ", "ャ", "ヨ", "ョ", "ユ", "ュ", "ッビャー", "ッビェー", "ッビョー", "ッビュー", "ッディー", "ッドゥー", "ッデュー", "ッグァー", "ッグェー", "ッグィー", "ッグォー", "ッギャー", "ッギェー", "ッギョー", "ッギュー", "ッジャー", "ッジェー", "ッジョー", "ッジュー", "ッンバー", "ッンベー", "ッンビー", "ッンボー", "ッンブー", "ッンパー", "ッンペー", "ッンピー", "ッンポー", "ッンプー", "ッピャー", "ッピェー", "ッピョー", "ッピュー", "ッヴァー", "ッヴェー", "ッヴィー", "ッヴォー", "ッヴョー", "ッヴュー", "ッズィー", "ッヂャー", "ッヂョー", "ッヂュー", "ッファー", "ッフェー", "ッフィー", "ッフォー", "ッフャー", "ッフョー", "ッフュー", "ッヒャー", "ッヒェー", "ッヒョー", "ッヒュー", "ックァー", "ックェー", "ックィー", "ックォー", "ッキャー", "ッキェー", "ッキョー", "ッキュー", "ッンマー", "ッンメー", "ッンミー", "ッンモー", "ッンムー", "ッミャー", "ッミェー", "ッミョー", "ッミュー", "ッンアー", "ッンエー", "ッンイー", "ッンナー", "ッンネー", "ッンニー", "ッンノー", "ッンヌー", "ッンオー", "ッンウー", "ッニャー", "ッニェー", "ッニェー", "ッニョー", "ッニュー", "ッリャー", "ッリェー", "ッリョー", "ッリュー", "ッシャー", "ッシェー", "ッシェー", "ッショー", "ッシュー", "ッスィー", "ッチャー", "ッチェー", "ッチェー", "ッチョー", "ッチュー", "ッティー", "ッオオー", "ッオウー", "ッツァー", "ッツェー", "ッツィー", "ッツォー", "ットゥー", "ッテュー", "ッウェー", "ッウィー", "ッウォー", "ッイェー", "ッバー", "ッベー", "ッビー", "ッボー", "ッブー", "ッビャ", "ッビェ", "ッビョ", "ッビュ", "ビャー", "ビェー", "ビョー", "ビュー", "ッダー", "ッデー", "ッディ", "ッドー", "ッドゥ", "ッデュ", "ッヅー", "ディー", "ドゥー", "デュー", "ッガー", "ッゲー", "ッギー", "ッゴー", "ッグー", "ッグァ", "ッグェ", "ッグィ", "ッグォ", "ッギャ", "ッギェ", "ッギョ", "ッギュ", "グァー", "グェー", "グィー", "グォー", "ギャー", "ギェー", "ギョー", "ギュー", "ジャー", "ジェー", "ッジャ", "ッジェ", "ッジー", "ッジョ", "ッジュ", "ジョー", "ジュー", "ンバー", "ンベー", "ンビー", "ンボー", "ンブー", "ッンバ", "ッンベ", "ッンビ", "ッンボ", "ッンブ", "ッンパ", "ッンペ", "ッンピ", "ッンポ", "ッンプ", "ンパー", "ンペー", "ンピー", "ンポー", "ンプー", "ッパー", "ッペー", "ッピー", "ッポー", "ップー", "ッピャ", "ッピェ", "ッピョ", "ッピュ", "ピャー", "ピェー", "ピョー", "ピュー", "ヴァー", "ヴェー", "ヴィー", "ヴォー", "ッヴァ", "ッヴェ", "ッヴィ", "ッヴォ", "ッヴー", "ッヴョ", "ッヴュ", "ヴョー", "ヴュー", "ズィー", "ヂャー", "ヂョー", "ヂュー", "ッザー", "ッゼー", "ッズィ", "ッヂー", "ッゾー", "ッズー", "ッヂャ", "ッヂョ", "ッヂュ", "チャー", "チェー", "チェー", "チョー", "チュー", "ファー", "フェー", "ッファ", "ッフェ", "ッフィ", "ッフォ", "ッフー", "ッフャ", "ッフョ", "ッフュ", "フィー", "フォー", "フャー", "フョー", "フュー", "ッハー", "ッヘー", "ッヒー", "ッホー", "ッヒャ", "ッヒェ", "ッヒョ", "ッヒュ", "ヒャー", "ヒェー", "ヒョー", "ヒュー", "ッカー", "ッケー", "ッキー", "ッコー", "ックー", "ックァ", "ックェ", "ックィ", "ックォ", "ッキャ", "ッキェ", "ッキョ", "ッキュ", "クァー", "クェー", "クィー", "クォー", "キャー", "キェー", "キョー", "キュー", "ンマー", "ッマー", "ンメー", "ッメー", "ンミー", "ッミー", "ッンマ", "ッンメ", "ッンミ", "ッンモ", "ッンム", "ンモー", "ッモー", "ンムー", "ッムー", "ッミャ", "ッミェ", "ッミョ", "ッミュ", "ミャー", "ミェー", "ミョー", "ミュー", "ンアー", "ッナー", "ンエー", "ッネー", "ンイー", "ッニー", "ッンア", "ンナー", "ッンエ", "ンネー", "ッンイ", "ンニー", "ッンナ", "ッンネ", "ッンニ", "ッンノ", "ッンヌ", "ッンオ", "ンノー", "ッンウ", "ンヌー", "ンオー", "ッノー", "ンウー", "ッヌー", "ッニャ", "ッニェ", "ッニョ", "ッニュ", "ニャー", "ニェー", "ニョー", "ニュー", "オオー", "オウー", "ッラー", "ッレー", "ッリー", "ッロー", "ッルー", "ッリャ", "ッリェ", "ッリョ", "ッリュ", "リャー", "リェー", "リョー", "リュー", "シャー", "シェー", "ショー", "シュー", "スィー", "ッサー", "ッセー", "ッシャ", "ッシェ", "ッシー", "ッショ", "ッシュ", "ッスィ", "ッソー", "ッスー", "ッチャ", "ッチェ", "ッチェ", "ッチー", "ッチョ", "ッチュ", "ティー", "ツァー", "ツェー", "ツィー", "ツォー", "ッアー", "ッター", "ッエー", "ッテー", "ッティ", "ッイー", "ッオオ", "ッオウ", "ッオー", "ットー", "ッツァ", "ッツェ", "ッツィ", "ッツォ", "ッツー", "ットゥ", "ッウー", "ッテュ", "トゥー", "テュー", "ウェー", "ウィー", "ウォー", "ッワー", "ッウェ", "ッヱー", "ッウィ", "ッヰー", "ッウォ", "ッヲー", "イェー", "イェー", "ッヤー", "ッイェ", "ッイェ", "ッヨー", "ッユー", "バー", "ッバ", "ッベ", "ッビ", "ッボ", "ッブ", "ベー", "ビー", "ボー", "ブー", "ビャ", "ビェ", "ビィ", "ビョ", "ビュ", "ダー", "ッダ", "ッデ", "ッド", "ッヅ", "デー", "ディ", "ドー", "ドゥ", "ドォ", "デャ", "デョ", "デュ", "ヅー", "ガー", "ゲー", "ッガ", "ッゲ", "ッギ", "ッゴ", "ッグ", "ギー", "ゴー", "グー", "グァ", "グェ", "グィ", "グォ", "ギャ", "ギェ", "ギィ", "ギョ", "ギュ", "ジャ", "ジェ", "ジー", "ッジ", "ジョ", "ジュ", "ジィ", "ンバ", "ンベ", "ンビ", "ンボ", "ンブ", "ンパ", "ンペ", "ンピ", "ンポ", "ンプ", "パー", "ペー", "ピー", "ポー", "ッパ", "ッペ", "ッピ", "ッポ", "ップ", "プー", "ピャ", "ピェ", "ピィ", "ピョ", "ピュ", "ヴァ", "ヴェ", "ヴィ", "ヴォ", "ヴー", "ッヴ", "ヴャ", "ヴョ", "ヴュ", "ザー", "ゼー", "ズィ", "ヂー", "ゾー", "ズー", "ヂャ", "ヂョ", "ヂュ", "ッザ", "ッゼ", "ッヂ", "ッゾ", "ッズ", "アー", "チャ", "チェ", "チー", "チョ", "チュ", "エー", "ファ", "フェ", "ッフ", "フィ", "フォ", "フー", "フゥ", "フャ", "フョ", "フュ", "ハー", "ヘー", "ッハ", "ッヘ", "ッヒ", "ッホ", "ヒー", "ホー", "ヒャ", "ヒェ", "ヒィ", "ヒョ", "ヒュ", "イー", "カー", "ケー", "キー", "ッカ", "ッケ", "ッキ", "ッコ", "ック", "コー", "クー", "クァ", "クェ", "クィ", "クォ", "キャ", "キェ", "キィ", "キョ", "キュ", "マー", "メー", "ミー", "ンマ", "ッマ", "ンメ", "ッメ", "ンミ", "ッミ", "ンモ", "ッモ", "ンム", "ッム", "モー", "ムー", "ミャ", "ミェ", "ミィ", "ミョ", "ミュ", "ナー", "ネー", "ニー", "ンア", "ッナ", "ンエ", "ッネ", "ンイ", "ッニ", "ンナ", "ンネ", "ンニ", "ンノ", "ンヌ", "ンオ", "ッノ", "ンウ", "ッヌ", "ノー", "ヌー", "ニャ", "ニェ", "ニィ", "ニョ", "ニュ", "オオ", "オウ", "オー", "クャ", "クョ", "クュ", "ラー", "レー", "リー", "ロー", "ッラ", "ッレ", "ッリ", "ッロ", "ッル", "ルー", "リャ", "リェ", "リィ", "リョ", "リュ", "サー", "セー", "シャ", "シェ", "シー", "ショ", "シュ", "スィ", "ソー", "ッサ", "ッセ", "ッシ", "ッソ", "ッス", "スー", "スァ", "スォ", "スゥ", "ター", "ッチ", "テー", "ティ", "トー", "ツァ", "ツェ", "ツィ", "ツォ", "ツー", "ッア", "ッタ", "ッエ", "ッテ", "ッイ", "ッオ", "ット", "ッツ", "ッウ", "トゥ", "テョ", "テュ", "ウー", "ワー", "ウェ", "ヱー", "ウィ", "ヰー", "ウォ", "ヲー", "ッワ", "ッヱ", "ッヰ", "ッヲ", "ヤー", "イェ", "ヨー", "ユー", "ッヤ", "ッヨ", "ッユ", "バ", "ベ", "ビ", "ボ", "ブ", "ダ", "デ", "ド", "ヅ", "ガ", "ゲ", "ギ", "ゴ", "グ", "ジ", "パ", "ペ", "ピ", "ポ", "プ", "ヴ", "ザ", "ゼ", "ヂ", "ゾ", "ズ", "ー", "ア", "ァ", "チ", "エ", "ェ", "フ", "ハ", "ヘ", "ヒ", "ホ", "イ", "ィ", "カ", "ケ", "キ", "コ", "ク", "マ", "メ", "ミ", "モ", "ム", "ン", "ナ", "ネ", "ニ", "ノ", "ヌ", "オ", "ォ", "ラ", "レ", "リ", "ロ", "ル", "サ", "セ", "シ", "ソ", "ス", "ッ", "タ", "テ", "ト", "ツ", "ウ", "ゥ", "ワ", "ヱ", "ヰ", "ヲ", "ヤ", "ャ", "ヨ", "ョ", "ユ", "ュ")
	ローマ字 = Array("bbyaa", "bbyee", "bbyoo", "bbyuu", "ddii", "dduu", "ddyuu", "ggwaa", "ggwee", "ggwii", "ggwoo", "ggyaa", "ggyee", "ggyoo", "ggyuu", "jjaa", "jjee", "jjoo", "jjuu", "mmbaa", "mmbee", "mmbii", "mmboo", "mmbuu", "mmpaa", "mmpee", "mmpii", "mmpoo", "mmpuu", "ppyaa", "ppyee", "ppyoo", "ppyuu", "vvaa", "vvee", "vvii", "vvoo", "vvyoo", "vvyuu", "zz'ii", "zzyaa", "zzyoo", "zzyuu", "ffaa", "ffee", "ffii", "ffoo", "ffyaa", "ffyoo", "ffyuu", "hhyaa", "hhyee", "hhyoo", "hhyuu", "kkwaa", "kkwee", "kkwii", "kkwoo", "kkyaa", "kkyee", "kkyoo", "kkyuu", "mmmaa", "mmmee", "mmmii", "mmmoo", "mmmuu", "mmyaa", "mmyee", "mmyoo", "mmyuu", "nnnaa", "nnnee", "nnnii", "nnnnaa", "nnnnee", "nnnnii", "nnnnoo", "nnnnuu", "nnnoo", "nnnuu", "nnyaa", "nnyee", "nnyee", "nnyoo", "nnyuu", "rryaa", "rryee", "rryoo", "rryuu", "sshaa", "sshee", "sshee", "sshoo", "sshuu", "ss'ii", "tchaa", "tchee", "tchee", "tchoo", "tchuu", "ttii", "ttohh", "ttohh", "ttsaa", "ttsee", "ttsii", "ttsoo", "ttuu", "ttyuu", "wwee", "wwii", "wwoo", "yyee", "bbaa", "bbee", "bbii", "bboo", "bbuu", "bbya", "bbye", "bbyo", "bbyu", "byaa", "byee", "byoo", "byuu", "ddaa", "ddee", "ddi", "ddoo", "ddu", "ddyu", "ddzuu", "dii", "duu", "dyuu", "ggaa", "ggee", "ggii", "ggoo", "gguu", "ggwa", "ggwe", "ggwi", "ggwo", "ggya", "ggye", "ggyo", "ggyu", "gwaa", "gwee", "gwii", "gwoo", "gyaa", "gyee", "gyoo", "gyuu", "jaa", "jee", "jja", "jje", "jjii", "jjo", "jju", "joo", "juu", "mbaa", "mbee", "mbii", "mboo", "mbuu", "mmba", "mmbe", "mmbi", "mmbo", "mmbu", "mmpa", "mmpe", "mmpi", "mmpo", "mmpu", "mpaa", "mpee", "mpii", "mpoo", "mpuu", "ppaa", "ppee", "ppii", "ppoo", "ppuu", "ppya", "ppye", "ppyo", "ppyu", "pyaa", "pyee", "pyoo", "pyuu", "vaa", "vee", "vii", "voo", "vva", "vve", "vvi", "vvo", "vvuu", "vvyo", "vvyu", "vyoo", "vyuu", "z'ii", "zyaa", "zyoo", "zyuu", "zzaa", "zzee", "zz'i", "zzjii", "zzoo", "zzuu", "zzya", "zzyo", "zzyu", "chaa", "chee", "chee", "choo", "chuu", "faa", "fee", "ffa", "ffe", "ffi", "ffo", "ffuu", "ffya", "ffyo", "ffyu", "fii", "foo", "fyaa", "fyoo", "fyuu", "hhaa", "hhee", "hhii", "hhoo", "hhya", "hhye", "hhyo", "hhyu", "hyaa", "hyee", "hyoo", "hyuu", "kkaa", "kkee", "kkii", "kkoo", "kkuu", "kkwa", "kkwe", "kkwi", "kkwo", "kkya", "kkye", "kkyo", "kkyu", "kwaa", "kwee", "kwii", "kwoo", "kyaa", "kyee", "kyoo", "kyuu", "mmaa", "mmaa", "mmee", "mmee", "mmii", "mmii", "mmma", "mmme", "mmmi", "mmmo", "mmmu", "mmoo", "mmoo", "mmuu", "mmuu", "mmya", "mmye", "mmyo", "mmyu", "myaa", "myee", "myoo", "myuu", "nnaa", "nnaa", "nnee", "nnee", "nnii", "nnii", "nnna", "nnnaa", "nnne", "nnnee", "nnni", "nnnii", "nnnna", "nnnne", "nnnni", "nnnno", "nnnnu", "nnno", "nnnoo", "nnnu", "nnnuu", "nnoo", "nnoo", "nnuu", "nnuu", "nnya", "nnye", "nnyo", "nnyu", "nyaa", "nyee", "nyoo", "nyuu", "ohh", "ohh", "rraa", "rree", "rrii", "rroo", "rruu", "rrya", "rrye", "rryo", "rryu", "ryaa", "ryee", "ryoo", "ryuu", "shaa", "shee", "shoo", "shuu", "s'ii", "ssaa", "ssee", "ssha", "sshe", "sshii", "ssho", "sshu", "ss'i", "ssoo", "ssuu", "tcha", "tche", "tche", "tchii", "tcho", "tchu", "tii", "tsaa", "tsee", "tsii", "tsoo", "ttaa", "ttaa", "ttee", "ttee", "tti", "ttii", "ttoh", "ttoh", "ttoo", "ttoo", "ttsa", "ttse", "ttsi", "ttso", "ttsuu", "ttu", "ttuu", "ttyu", "tuu", "tyuu", "wee", "wii", "woo", "wwaa", "wwe", "wwee", "wwi", "wwii", "wwo", "wwoo", "yee", "yee", "yyaa", "yye", "yye", "yyoo", "yyuu", "baa", "bba", "bbe", "bbi", "bbo", "bbu", "bee", "bii", "boo", "buu", "bya", "bye", "byi", "byo", "byu", "daa", "dda", "dde", "ddo", "ddzu", "dee", "di", "doo", "du", "dwo", "dya", "dyo", "dyu", "dzuu", "gaa", "gee", "gga", "gge", "ggi", "ggo", "ggu", "gii", "goo", "guu", "gwa", "gwe", "gwi", "gwo", "gya", "gye", "gyi", "gyo", "gyu", "ja", "je", "jii", "jji", "jo", "ju", "jyi", "mba", "mbe", "mbi", "mbo", "mbu", "mpa", "mpe", "mpi", "mpo", "mpu", "paa", "pee", "pii", "poo", "ppa", "ppe", "ppi", "ppo", "ppu", "puu", "pya", "pye", "pyi", "pyo", "pyu", "va", "ve", "vi", "vo", "vuu", "vvu", "vya", "vyo", "vyu", "zaa", "zee", "z'i", "zjii", "zoo", "zuu", "zya", "zyo", "zyu", "zza", "zze", "zzji", "zzo", "zzu", "aa", "cha", "che", "chii", "cho", "chu", "ee", "fa", "fe", "ffu", "fi", "fo", "fuu", "fwu", "fya", "fyo", "fyu", "haa", "hee", "hha", "hhe", "hhi", "hho", "hii", "hoo", "hya", "hye", "hyi", "hyo", "hyu", "ii", "kaa", "kee", "kii", "kka", "kke", "kki", "kko", "kku", "koo", "kuu", "kwa", "kwe", "kwi", "kwo", "kya", "kye", "kyi", "kyo", "kyu", "maa", "mee", "mii", "mma", "mma", "mme", "mme", "mmi", "mmi", "mmo", "mmo", "mmu", "mmu", "moo", "muu", "mya", "mye", "myi", "myo", "myu", "naa", "nee", "nii", "nna", "nna", "nne", "nne", "nni", "nni", "nnna", "nnne", "nnni", "nnno", "nnnu", "nno", "nno", "nnu", "nnu", "noo", "nuu", "nya", "nye", "nyi", "nyo", "nyu", "oh", "oh", "oo", "qya", "qyo", "qyu", "raa", "ree", "rii", "roo", "rra", "rre", "rri", "rro", "rru", "ruu", "rya", "rye", "ryi", "ryo", "ryu", "saa", "see", "sha", "she", "shii", "sho", "shu", "s'i", "soo", "ssa", "sse", "sshi", "sso", "ssu", "suu", "swa", "swo", "swu", "taa", "tchi", "tee", "ti", "too", "tsa", "tse", "tsi", "tso", "tsuu", "tta", "tta", "tte", "tte", "tti", "tto", "tto", "ttsu", "ttu", "tu", "tyo", "tyu", "uu", "waa", "we", "wee", "wi", "wii", "wo", "woo", "wwa", "wwe", "wwi", "wwo", "yaa", "ye", "yoo", "yuu", "yya", "yyo", "yyu", "ba", "be", "bi", "bo", "bu", "da", "de", "do", "dzu", "ga", "ge", "gi", "go", "gu", "ji", "pa", "pe", "pi", "po", "pu", "vu", "za", "ze", "zi", "zo", "zu", "-", "a", "a", "chi", "e", "e", "fu", "ha", "he", "hi", "ho", "i", "i", "ka", "ke", "ki", "ko", "ku", "ma", "me", "mi", "mo", "mu", "n", "na", "ne", "ni", "no", "nu", "o", "o", "ra", "re", "ri", "ro", "ru", "sa", "se", "shi", "so", "su", "t", "ta", "te", "to", "tsu", "u", "u", "wa", "we", "wi", "wo", "ya", "ya", "yo", "yo", "yu", "yu", "bbyaa", "bbyee", "bbyoo", "bbyuu", "ddii", "dduu", "ddyuu", "ggwaa", "ggwee", "ggwii", "ggwoo", "ggyaa", "ggyee", "ggyoo", "ggyuu", "jjaa", "jjee", "jjoo", "jjuu", "mmbaa", "mmbee", "mmbii", "mmboo", "mmbuu", "mmpaa", "mmpee", "mmpii", "mmpoo", "mmpuu", "ppyaa", "ppyee", "ppyoo", "ppyuu", "vvaa", "vvee", "vvii", "vvoo", "vvyoo", "vvyuu", "zz'ii", "zzyaa", "zzyoo", "zzyuu", "ffaa", "ffee", "ffii", "ffoo", "ffyaa", "ffyoo", "ffyuu", "hhyaa", "hhyee", "hhyoo", "hhyuu", "kkwaa", "kkwee", "kkwii", "kkwoo", "kkyaa", "kkyee", "kkyoo", "kkyuu", "mmmaa", "mmmee", "mmmii", "mmmoo", "mmmuu", "mmyaa", "mmyee", "mmyoo", "mmyuu", "nnnaa", "nnnee", "nnnii", "nnnnaa", "nnnnee", "nnnnii", "nnnnoo", "nnnnuu", "nnnoo", "nnnuu", "nnyaa", "nnyee", "nnyee", "nnyoo", "nnyuu", "rryaa", "rryee", "rryoo", "rryuu", "sshaa", "sshee", "sshee", "sshoo", "sshuu", "ss'ii", "tchaa", "tchee", "tchee", "tchoo", "tchuu", "ttii", "ttohh", "ttohh", "ttsaa", "ttsee", "ttsii", "ttsoo", "ttuu", "ttyuu", "wwee", "wwii", "wwoo", "yyee", "bbaa", "bbee", "bbii", "bboo", "bbuu", "bbya", "bbye", "bbyo", "bbyu", "byaa", "byee", "byoo", "byuu", "ddaa", "ddee", "ddi", "ddoo", "ddu", "ddyu", "ddzuu", "dii", "duu", "dyuu", "ggaa", "ggee", "ggii", "ggoo", "gguu", "ggwa", "ggwe", "ggwi", "ggwo", "ggya", "ggye", "ggyo", "ggyu", "gwaa", "gwee", "gwii", "gwoo", "gyaa", "gyee", "gyoo", "gyuu", "jaa", "jee", "jja", "jje", "jjii", "jjo", "jju", "joo", "juu", "mbaa", "mbee", "mbii", "mboo", "mbuu", "mmba", "mmbe", "mmbi", "mmbo", "mmbu", "mmpa", "mmpe", "mmpi", "mmpo", "mmpu", "mpaa", "mpee", "mpii", "mpoo", "mpuu", "ppaa", "ppee", "ppii", "ppoo", "ppuu", "ppya", "ppye", "ppyo", "ppyu", "pyaa", "pyee", "pyoo", "pyuu", "vaa", "vee", "vii", "voo", "vva", "vve", "vvi", "vvo", "vvuu", "vvyo", "vvyu", "vyoo", "vyuu", "z'ii", "zyaa", "zyoo", "zyuu", "zzaa", "zzee", "zz'i", "zzjii", "zzoo", "zzuu", "zzya", "zzyo", "zzyu", "chaa", "chee", "chee", "choo", "chuu", "faa", "fee", "ffa", "ffe", "ffi", "ffo", "ffuu", "ffya", "ffyo", "ffyu", "fii", "foo", "fyaa", "fyoo", "fyuu", "hhaa", "hhee", "hhii", "hhoo", "hhya", "hhye", "hhyo", "hhyu", "hyaa", "hyee", "hyoo", "hyuu", "kkaa", "kkee", "kkii", "kkoo", "kkuu", "kkwa", "kkwe", "kkwi", "kkwo", "kkya", "kkye", "kkyo", "kkyu", "kwaa", "kwee", "kwii", "kwoo", "kyaa", "kyee", "kyoo", "kyuu", "mmaa", "mmaa", "mmee", "mmee", "mmii", "mmii", "mmma", "mmme", "mmmi", "mmmo", "mmmu", "mmoo", "mmoo", "mmuu", "mmuu", "mmya", "mmye", "mmyo", "mmyu", "myaa", "myee", "myoo", "myuu", "nnaa", "nnaa", "nnee", "nnee", "nnii", "nnii", "nnna", "nnnaa", "nnne", "nnnee", "nnni", "nnnii", "nnnna", "nnnne", "nnnni", "nnnno", "nnnnu", "nnno", "nnnoo", "nnnu", "nnnuu", "nnoo", "nnoo", "nnuu", "nnuu", "nnya", "nnye", "nnyo", "nnyu", "nyaa", "nyee", "nyoo", "nyuu", "ohh", "ohh", "rraa", "rree", "rrii", "rroo", "rruu", "rrya", "rrye", "rryo", "rryu", "ryaa", "ryee", "ryoo", "ryuu", "shaa", "shee", "shoo", "shuu", "s'ii", "ssaa", "ssee", "ssha", "sshe", "sshii", "ssho", "sshu", "ss'i", "ssoo", "ssuu", "tcha", "tche", "tche", "tchii", "tcho", "tchu", "tii", "tsaa", "tsee", "tsii", "tsoo", "ttaa", "ttaa", "ttee", "ttee", "tti", "ttii", "ttoh", "ttoh", "ttoo", "ttoo", "ttsa", "ttse", "ttsi", "ttso", "ttsuu", "ttu", "ttuu", "ttyu", "tuu", "tyuu", "wee", "wii", "woo", "wwaa", "wwe", "wwee", "wwi", "wwii", "wwo", "wwoo", "yee", "yee", "yyaa", "yye", "yye", "yyoo", "yyuu", "baa", "bba", "bbe", "bbi", "bbo", "bbu", "bee", "bii", "boo", "buu", "bya", "bye", "byi", "byo", "byu", "daa", "dda", "dde", "ddo", "ddzu", "dee", "di", "doo", "du", "dwo", "dya", "dyo", "dyu", "dzuu", "gaa", "gee", "gga", "gge", "ggi", "ggo", "ggu", "gii", "goo", "guu", "gwa", "gwe", "gwi", "gwo", "gya", "gye", "gyi", "gyo", "gyu", "ja", "je", "jii", "jji", "jo", "ju", "jyi", "mba", "mbe", "mbi", "mbo", "mbu", "mpa", "mpe", "mpi", "mpo", "mpu", "paa", "pee", "pii", "poo", "ppa", "ppe", "ppi", "ppo", "ppu", "puu", "pya", "pye", "pyi", "pyo", "pyu", "va", "ve", "vi", "vo", "vuu", "vvu", "vya", "vyo", "vyu", "zaa", "zee", "z'i", "zjii", "zoo", "zuu", "zya", "zyo", "zyu", "zza", "zze", "zzji", "zzo", "zzu", "aa", "cha", "che", "chii", "cho", "chu", "ee", "fa", "fe", "ffu", "fi", "fo", "fuu", "fwu", "fya", "fyo", "fyu", "haa", "hee", "hha", "hhe", "hhi", "hho", "hii", "hoo", "hya", "hye", "hyi", "hyo", "hyu", "ii", "kaa", "kee", "kii", "kka", "kke", "kki", "kko", "kku", "koo", "kuu", "kwa", "kwe", "kwi", "kwo", "kya", "kye", "kyi", "kyo", "kyu", "maa", "mee", "mii", "mma", "mma", "mme", "mme", "mmi", "mmi", "mmo", "mmo", "mmu", "mmu", "moo", "muu", "mya", "mye", "myi", "myo", "myu", "naa", "nee", "nii", "nna", "nna", "nne", "nne", "nni", "nni", "nnna", "nnne", "nnni", "nnno", "nnnu", "nno", "nno", "nnu", "nnu", "noo", "nuu", "nya", "nye", "nyi", "nyo", "nyu", "oh", "oh", "oo", "qya", "qyo", "qyu", "raa", "ree", "rii", "roo", "rra", "rre", "rri", "rro", "rru", "ruu", "rya", "rye", "ryi", "ryo", "ryu", "saa", "see", "sha", "she", "shii", "sho", "shu", "s'i", "soo", "ssa", "sse", "sshi", "sso", "ssu", "suu", "swa", "swo", "swu", "taa", "tchi", "tee", "ti", "too", "tsa", "tse", "tsi", "tso", "tsuu", "tta", "tta", "tte", "tte", "tti", "tto", "tto", "ttsu", "ttu", "tu", "tyo", "tyu", "uu", "waa", "we", "wee", "wi", "wii", "wo", "woo", "wwa", "wwe", "wwi", "wwo", "yaa", "ye", "yoo", "yuu", "yya", "yyo", "yyu", "ba", "be", "bi", "bo", "bu", "da", "de", "do", "dzu", "ga", "ge", "gi", "go", "gu", "ji", "pa", "pe", "pi", "po", "pu", "vu", "za", "ze", "zi", "zo", "zu", "-", "a", "a", "chi", "e", "e", "fu", "ha", "he", "hi", "ho", "i", "i", "ka", "ke", "ki", "ko", "ku", "ma", "me", "mi", "mo", "mu", "n", "na", "ne", "ni", "no", "nu", "o", "o", "ra", "re", "ri", "ro", "ru", "sa", "se", "shi", "so", "su", "t", "ta", "te", "to", "tsu", "u", "u", "wa", "we", "wi", "wo", "ya", "ya", "yo", "yo", "yu", "yu")
	'2007/09/15
	
	?  UBound(カナ)
	For i = 0 To UBound(カナ)
		文字列 = Replace(文字列, カナ(i), ローマ字(i))
	Next
	カナ→ローマ字変換 = 文字列
End Function


'**********************************************************
'★★★★    メイン     ★★★★
'**********************************************************
Dim 既存内容, 変換対象, ExcelOn, E変換対象
Dim Excel

HotVBS.Sleep 200
既存内容 = HotVBS.ClipBoard    ?    '既存のクリップボードの内容を、既存内容に退避。
HotVBS.ClipBoard = ""	 'クリップボードの内容をクリア

'**************************************
'Excelの起動判定(エディタのクラス名のライブラリを使用)

ExcelOn = 0

If InStr(HotVBS.Class, "EXCEL") = 1 Then
	ExcelOn = 1
End If

? ExcelOn

'**************************************
HotVBS.Sleep 800   'エラーを出さないように、0.8秒待たす

HotVBS.Copy		'選択中のデータを、クリップボードにコピー
変換対象 = HotVBS.ClipBoard   ? 'クリップボードに取り込んだ選択中のデータを、変数「変換対象」に格納。

'**************************************
If ExcelOn = 1 Then          'Excelが起動している場合
	HotVBS.Sleep 300   'エラーを出さないように、0.3秒待たす

	'GetObject 関数で、オートメーション オブジェクトにアクセスしたり、
	'取得したオブジェクトへの参照をオブジェクト変数に代入することができます。
	'この例では、引数 パス を省略して、現在アクティブなオブジェクト(Excel.Application)を取得しています。
	
	Set Excel = GetObject(, "Excel.Application")
	HotVBS.Sleep 300
	
	'Excel操作で、選択中のセル範囲をコピーする。
	Excel.Selection.Copy
	
	HotVBS.Sleep 200   'エラーを出さないように、0.2秒待たす
	
	E変換対象 = HotVBS.ClipBoard      ?    'コピーした内容を、変換対象とてし、変数E変換対象に格納
	E変換対象 = カナ→ローマ字変換(E変換対象)          'カナ→ローマ字変換
	HotVBS.ClipBoard = E変換対象           'ローマ字変換後の文字列を、クリップボードに戻す

	Excel.ActiveSheet.Paste         'クリップボードのデータを、起動中の画面に貼付け

	'Application オブジェクトのプロパティを使って、コピー範囲の点線枠を外します。
	Excel.CutCopyMode = False
	
	'変数が参照しているオブジェクトとの関連付けを、解除します。
	Set Excel = Nothing
	
'**************************************
ElseIf 変換対象 = ""  Then 
	'Excelが起動していなくて、選択中のデータが無い場合
	HotVBS.SelAll         'アクティブな画面で、全選択する
	HotVBS.Copy           '全選択した内容をコピー
	変換対象 = HotVBS.ClipBoard  '全選択した内容を、変換対象とてし、変数Sに格納
	変換対象 = カナ→ローマ字変換(変換対象)  'カナ→ローマ字変換
	HotVBS.ClipBoard = 変換対象  'ローマ字変換後の文字列を、クリップボードに戻す
	HotVBS.Past           'クリップボードのデータを、起動中の画面に貼付け
	
'**************************************
Else
	'Excelが起動していなくて、選択範囲から、文字列を取得できた場合
	変換対象 = カナ→ローマ字変換(変換対象)  'カナ→ローマ字変換
	HotVBS.ClipBoard = 変換対象  'ローマ字変換後の文字列を、クリップボードに戻す
	HotVBS.Past           'クリップボードのデータを、起動中の画面に貼付け
End If
'**************************************

HotVBS.ClipBoard = 既存内容 '退避してあったデータを、クリップボードに戻す
'****************************************************************


 解説:
 GetObject 関数は、ファイルから取得したオートメーション オブジェクトへの参照を返します。

 GetObject 関数を使用して、ファイルから取得したオートメーション オブジェクトにアクセスしたり、取得したオブジェクトへの参照をオブジェクト変数に代入することができます。
 GetObject関数で取得したオブジェクトをオブジェクト変数に代入するには、Set ステートメントを使用します。

 GetObject([pathname] [, class])

pathname 省略可能です。文字列を指定します。取得するオブジェクトが含まれているファイルの絶対パスおよびファイル名を指定します。引数 pathname に長さ 0 の文字列 ("") を指定した場合は、引数 class も指定する必要があります。
class 省略可能です。文字列を指定します。オブジェクトのクラスを表す文字列を指定します。
引数class は、appname.objectype の形式で指定します。

コード例:

 Dim CADObject
 Set CADObject = GetObject("C:\CAD\SCHEMA.CAD")

 このコード例を実行すると、引数 pathname に指定したファイルに関連付けられているアプリケーションが起動され、指定したファイル内のオブジェクトがアクティブになります。

 引数 pathname に長さ 0 の文字列 ("") を指定すると、GetObject 関数は、指定した種類の新しいオブジェクト (インスタンス) を返します。

 引数 pathname を省略すると、GetObject 関数は、指定した種類の現在アクティブなオブジェクトを返します。
指定した種類のオブジェクトが存在しない場合はエラーが発生します。

 ファイルの一部をアクティブにするアプリケーションもあります。
ファイルの一部をアクティブにするには、ファイル名の後に感嘆符 (!) を付け、アクティブにする部分を表す文字列をその後に指定します。この文字列の指定方法については、そのオブジェクトを提供するアプリケーションのマニュアルを参照してください。

 たとえば、描画アプリケーションでは、1 つのファイルに格納されている描画が、複数の階層に分かれていることがあります。このような場合は、次のコード例ように記述すると、SCHEMA.CAD という描画ファイル内の 1 つの階層をアクティブにできます。
 Set LayerObject = GetObject("C:\CAD\SCHEMA.CAD!Layer3")

 オブジェクトの引数 class を指定しない場合、オートメーションが、指定したファイル名に基づいて起動するアプリケーションおよびアクティブにするオブジェクトを決定します。
ただし、ファイルによっては複数のオブジェクトのクラスがサポートされています。たとえば、ある描画アプリケーションでは、3 つの異なる種類のオブジェクト、Application オブジェクト、Drawing オブジェクト、および Toolbar オブジェクトがサポートされていて、どのオブジェクトも同じファイル内にあるものと仮定します。
このような場合は、引数 class を使用して、ファイル内のアクティブにするオブジェクトを指定します。

コード例:
 Dim MyObject
 Set MyObject = GetObject("C:\DRAWINGS\SAMPLE.DRW", "FIGMENT.DRAWING")
 このコード例では、FIGMENT は描画アプリケーションの名前で、DRAWING は、FIGMENT がサポートしているオブジェクトの種類の 1 つです。一度、オブジェクトがアクティブになれば、定義したオブジェクト変数を使用して、そのオブジェクトを参照できるようになります。

 上の例の場合、オブジェクト変数 MyObject を使用して、アクティブになったオブジェクトのプロパティやメソッドを操作することができます。
 コード例:
 MyObject.Line 9, 90
 MyObject.InsertText 9, 100, "Hello, world."
 MyObject.SaveAs "C:\DRAWINGS\SAMPLE.DRW"

 カレント オブジェクトのインスタンスがあるとき、または、既に読み込まれたファイルを使用してオブジェクトを作成するときは、GetObject 関数を使用します。
 カレント オブジェクトのインスタンスがなく、ファイルを使用してオブジェクトを作成しないときは、CreateObject 関数を使用します。
 複数のインスタンスを作成できないオブジェクトの場合は、何度 CreateObject 関数を実行しても、そのオブジェクトのインスタンスは 1 つしか作成されません。また、複数のインスタンスを作成できないオブジェクトの場合、長さ 0 の文字列 ("") を指定して GetObject 関数を呼び出すと常に同じインスタンスを返し、引数 pathname を省略するとエラーが発生します。


CreateObject 関数は、オートメーション オブジェクトへの参照を作成して返します。
 オートメーション サーバーは、少なくとも 1 種類のオブジェクトを提供しています。たとえば、ワード プロセッサであれば、アプリケーション オブジェクト、文書オブジェクト、ツールバー オブジェクトなどが提供されます。
 オートメーション オブジェクトを作成するには、CreateObject 関数の戻り値をオブジェクト変数に代入します。

CreateObject(servername.typename [, location])
servername 必ず指定します。オブジェクトを提供しているアプリケーションの名前を指定します。

typename 必ず指定します。作成するオブジェクトの種類またはクラスを指定します。

location 省略可能です。オブジェクトが作成されるサーバーの名前を指定します。

コード例:

Dim ExcelSheet
Set ExcelSheet = CreateObject("Excel.Sheet")

 このコード例では、オブジェクトを提供するアプリケーション (この場合、Microsoft Excel のワークシート) が起動します。定義したオブジェクト変数を使って、コード内で作成されたオブジェクトを参照することができます。
 次のコードは、ActiveSheet.Cells コレクションの Application オブジェクトに含まれるオブジェクト変数 ExcelSheet およびその他の Excel オブジェクトを使って、新しく作成されたオブジェクトのプロパティやメソッドを操作する例です。


' Application オブジェクトから Excel のワークシートを表示します。
ExcelSheet.Application.Visible = True
' ワークシートの最初のセルにテキストを入力します。
ExcelSheet.ActiveSheet.Cells(1,1).Value = "この位置は、1 行 A 列目です。"
' ワークシートを名前を付けて保存します。
ExcelSheet.SaveAs "C:\DOCS\TEST.XLS"
' Application オブジェクトの Quit メソッドで Excel を終了します。
ExcelSheet.Application.Quit
' オブジェクト変数を開放します。
Set ExcelSheet = Nothing

 リモート サーバー上のオブジェクトの作成は、インターネットのセキュリティが切られている場合のみ行うことができます。
 コンピュータ名を CreateObject 関数の引数 servername に渡すことで、リモートのネットワークで接続されたコンピュータ上にオブジェクトを作成できます。この名前は、共有名のマシン名の部分と同じです。
 たとえば、"\\myserver\public" というネットワークの共有名では、"myserver" が servername となります。さらに、DNS 形式または IP アドレスを使用して servername を指定することもできます。

 次のコードは、"Myserver" という名前のリモート ネットワーク コンピュータ上で実行されている、Excel のインスタンスのバージョン番号を返す例です。


Function GetVersion
   Dim XLApp
   Set XLApp = CreateObject("Excel.Application", "MyServer")
   GetVersion = XLApp.Version
End Function

 指定したリモート サーバーが、ネットワーク上に存在しないか見つからない場合、エラーが発生します。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


カナ→ローマ字変換(Excelのセル一つずつ:参考)

 処理のポイント:
1.Replace を使って、文字列を置換。
2.GetObject を使って、起動中の Excel のセル範囲を、2元配列オブジェクトに格納して、Excel セルのデータを直接更新する。
  セルを一つずつ変換していくので、この事例では、時間がかかり、不適切。
 この Excel セルのデータを直接更新する方式が、有用な場合も有るので、参考までに残しています。


'	カナ→ローマ字変換(セル一つずつ)
'*****************************************************************
'■経歴
'	作成 2007/09/15
'	変更 2007/09/22
'	変更 2007/10/08 変数名の漢字化
	
'■用途:
'	Excelの選択セル範囲や、アクティブなテキスト上の「カナ(全角・半角)」を、
'	ヘボン式に準拠した、ローマ字表記に変換します。

'	例えば、カナ表記の氏名を、ローマ字表記に変更する場合などに、使います。

'■使い方
'	Excelの場合は、変換対象のセル範囲を選択状態にして、
'	テキスト・エディタの場合も、変換したい範囲を、選択状態にして、
'	ホットキー操作すると、カナ→ローマ字変換します。

'	テキスト・エディタの場合は、「Excelが起動していない状態」ならば、
'	変換対象ファイルを、マウスク左クリックでアクティブにして、
'	ホットキー操作すると、自動で全選択して、カナ→ローマ字変換します。

'****************************************************************

Option Explicit

Dim カナ, ローマ字, i, j, k

'選択全行を変換
'****************************************************************
Function カナ→ローマ字(文字列)
'****************************************************************
	'0〜1549
	'このローマ字表は、ヘボン式・英国式・その他の表記を参考に、
	'渡辺真が編纂したものです。
	'このクレジットを付記していただければ、ことわりなく、転載、改変など、随意にしていただいてかまいません。
	カナ = Array("ッビャー", "ッビェー", "ッビョー", "ッビュー", "ッディー", "ッドゥー", "ッデュー", "ッグァー", "ッグェー", "ッグィー", "ッグォー", "ッギャー", "ッギェー", "ッギョー", "ッギュー", "ッジャー", "ッジェー", "ッジョー", "ッジュー", "ッンバー", "ッンベー", "ッンビー", "ッンボー", "ッンブー", "ッンパー", "ッンペー", "ッンピー", "ッンポー", "ッンプー", "ッピャー", "ッピェー", "ッピョー", "ッピュー", "ッヴァー", "ッヴェー", "ッヴィー", "ッヴォー", "ッヴョー", "ッヴュー", "ッズィー", "ッヂャー", "ッヂョー", "ッヂュー", "ッファー", "ッフェー", "ッフィー", "ッフォー", "ッフャー", "ッフョー", "ッフュー", "ッヒャー", "ッヒェー", "ッヒョー", "ッヒュー", "ックァー", "ックェー", "ックィー", "ックォー", "ッキャー", "ッキェー", "ッキョー", "ッキュー", "ッンマー", "ッンメー", "ッンミー", "ッンモー", "ッンムー", "ッミャー", "ッミェー", "ッミョー", "ッミュー", "ッンアー", "ッンエー", "ッンイー", "ッンナー", "ッンネー", "ッンニー", "ッンノー", "ッンヌー", "ッンオー", "ッンウー", "ッニャー", "ッニェー", "ッニェー", "ッニョー", "ッニュー", "ッリャー", "ッリェー", "ッリョー", "ッリュー", "ッシャー", "ッシェー", "ッシェー", "ッショー", "ッシュー", "ッスィー", "ッチャー", "ッチェー", "ッチェー", "ッチョー", "ッチュー", "ッティー", "ッオオー", "ッオウー", "ッツァー", "ッツェー", "ッツィー", "ッツォー", "ットゥー", "ッテュー", "ッウェー", "ッウィー", "ッウォー", "ッイェー", "ッバー", "ッベー", "ッビー", "ッボー", "ッブー", "ッビャ", "ッビェ", "ッビョ", "ッビュ", "ビャー", "ビェー", "ビョー", "ビュー", "ッダー", "ッデー", "ッディ", "ッドー", "ッドゥ", "ッデュ", "ッヅー", "ディー", "ドゥー", "デュー", "ッガー", "ッゲー", "ッギー", "ッゴー", "ッグー", "ッグァ", "ッグェ", "ッグィ", "ッグォ", "ッギャ", "ッギェ", "ッギョ", "ッギュ", "グァー", "グェー", "グィー", "グォー", "ギャー", "ギェー", "ギョー", "ギュー", "ジャー", "ジェー", "ッジャ", "ッジェ", "ッジー", "ッジョ", "ッジュ", "ジョー", "ジュー", "ンバー", "ンベー", "ンビー", "ンボー", "ンブー", "ッンバ", "ッンベ", "ッンビ", "ッンボ", "ッンブ", "ッンパ", "ッンペ", "ッンピ", "ッンポ", "ッンプ", "ンパー", "ンペー", "ンピー", "ンポー", "ンプー", "ッパー", "ッペー", "ッピー", "ッポー", "ップー", "ッピャ", "ッピェ", "ッピョ", "ッピュ", "ピャー", "ピェー", "ピョー", "ピュー", "ヴァー", "ヴェー", "ヴィー", "ヴォー", "ッヴァ", "ッヴェ", "ッヴィ", "ッヴォ", "ッヴー", "ッヴョ", "ッヴュ", "ヴョー", "ヴュー", "ズィー", "ヂャー", "ヂョー", "ヂュー", "ッザー", "ッゼー", "ッズィ", "ッヂー", "ッゾー", "ッズー", "ッヂャ", "ッヂョ", "ッヂュ", "チャー", "チェー", "チェー", "チョー", "チュー", "ファー", "フェー", "ッファ", "ッフェ", "ッフィ", "ッフォ", "ッフー", "ッフャ", "ッフョ", "ッフュ", "フィー", "フォー", "フャー", "フョー", "フュー", "ッハー", "ッヘー", "ッヒー", "ッホー", "ッヒャ", "ッヒェ", "ッヒョ", "ッヒュ", "ヒャー", "ヒェー", "ヒョー", "ヒュー", "ッカー", "ッケー", "ッキー", "ッコー", "ックー", "ックァ", "ックェ", "ックィ", "ックォ", "ッキャ", "ッキェ", "ッキョ", "ッキュ", "クァー", "クェー", "クィー", "クォー", "キャー", "キェー", "キョー", "キュー", "ンマー", "ッマー", "ンメー", "ッメー", "ンミー", "ッミー", "ッンマ", "ッンメ", "ッンミ", "ッンモ", "ッンム", "ンモー", "ッモー", "ンムー", "ッムー", "ッミャ", "ッミェ", "ッミョ", "ッミュ", "ミャー", "ミェー", "ミョー", "ミュー", "ンアー", "ッナー", "ンエー", "ッネー", "ンイー", "ッニー", "ッンア", "ンナー", "ッンエ", "ンネー", "ッンイ", "ンニー", "ッンナ", "ッンネ", "ッンニ", "ッンノ", "ッンヌ", "ッンオ", "ンノー", "ッンウ", "ンヌー", "ンオー", "ッノー", "ンウー", "ッヌー", "ッニャ", "ッニェ", "ッニョ", "ッニュ", "ニャー", "ニェー", "ニョー", "ニュー", "オオー", "オウー", "ッラー", "ッレー", "ッリー", "ッロー", "ッルー", "ッリャ", "ッリェ", "ッリョ", "ッリュ", "リャー", "リェー", "リョー", "リュー", "シャー", "シェー", "ショー", "シュー", "スィー", "ッサー", "ッセー", "ッシャ", "ッシェ", "ッシー", "ッショ", "ッシュ", "ッスィ", "ッソー", "ッスー", "ッチャ", "ッチェ", "ッチェ", "ッチー", "ッチョ", "ッチュ", "ティー", "ツァー", "ツェー", "ツィー", "ツォー", "ッアー", "ッター", "ッエー", "ッテー", "ッティ", "ッイー", "ッオオ", "ッオウ", "ッオー", "ットー", "ッツァ", "ッツェ", "ッツィ", "ッツォ", "ッツー", "ットゥ", "ッウー", "ッテュ", "トゥー", "テュー", "ウェー", "ウィー", "ウォー", "ッワー", "ッウェ", "ッヱー", "ッウィ", "ッヰー", "ッウォ", "ッヲー", "イェー", "イェー", "ッヤー", "ッイェ", "ッイェ", "ッヨー", "ッユー", "バー", "ッバ", "ッベ", "ッビ", "ッボ", "ッブ", "ベー", "ビー", "ボー", "ブー", "ビャ", "ビェ", "ビィ", "ビョ", "ビュ", "ダー", "ッダ", "ッデ", "ッド", "ッヅ", "デー", "ディ", "ドー", "ドゥ", "ドォ", "デャ", "デョ", "デュ", "ヅー", "ガー", "ゲー", "ッガ", "ッゲ", "ッギ", "ッゴ", "ッグ", "ギー", "ゴー", "グー", "グァ", "グェ", "グィ", "グォ", "ギャ", "ギェ", "ギィ", "ギョ", "ギュ", "ジャ", "ジェ", "ジー", "ッジ", "ジョ", "ジュ", "ジィ", "ンバ", "ンベ", "ンビ", "ンボ", "ンブ", "ンパ", "ンペ", "ンピ", "ンポ", "ンプ", "パー", "ペー", "ピー", "ポー", "ッパ", "ッペ", "ッピ", "ッポ", "ップ", "プー", "ピャ", "ピェ", "ピィ", "ピョ", "ピュ", "ヴァ", "ヴェ", "ヴィ", "ヴォ", "ヴー", "ッヴ", "ヴャ", "ヴョ", "ヴュ", "ザー", "ゼー", "ズィ", "ヂー", "ゾー", "ズー", "ヂャ", "ヂョ", "ヂュ", "ッザ", "ッゼ", "ッヂ", "ッゾ", "ッズ", "アー", "チャ", "チェ", "チー", "チョ", "チュ", "エー", "ファ", "フェ", "ッフ", "フィ", "フォ", "フー", "フゥ", "フャ", "フョ", "フュ", "ハー", "ヘー", "ッハ", "ッヘ", "ッヒ", "ッホ", "ヒー", "ホー", "ヒャ", "ヒェ", "ヒィ", "ヒョ", "ヒュ", "イー", "カー", "ケー", "キー", "ッカ", "ッケ", "ッキ", "ッコ", "ック", "コー", "クー", "クァ", "クェ", "クィ", "クォ", "キャ", "キェ", "キィ", "キョ", "キュ", "マー", "メー", "ミー", "ンマ", "ッマ", "ンメ", "ッメ", "ンミ", "ッミ", "ンモ", "ッモ", "ンム", "ッム", "モー", "ムー", "ミャ", "ミェ", "ミィ", "ミョ", "ミュ", "ナー", "ネー", "ニー", "ンア", "ッナ", "ンエ", "ッネ", "ンイ", "ッニ", "ンナ", "ンネ", "ンニ", "ンノ", "ンヌ", "ンオ", "ッノ", "ンウ", "ッヌ", "ノー", "ヌー", "ニャ", "ニェ", "ニィ", "ニョ", "ニュ", "オオ", "オウ", "オー", "クャ", "クョ", "クュ", "ラー", "レー", "リー", "ロー", "ッラ", "ッレ", "ッリ", "ッロ", "ッル", "ルー", "リャ", "リェ", "リィ", "リョ", "リュ", "サー", "セー", "シャ", "シェ", "シー", "ショ", "シュ", "スィ", "ソー", "ッサ", "ッセ", "ッシ", "ッソ", "ッス", "スー", "スァ", "スォ", "スゥ", "ター", "ッチ", "テー", "ティ", "トー", "ツァ", "ツェ", "ツィ", "ツォ", "ツー", "ッア", "ッタ", "ッエ", "ッテ", "ッイ", "ッオ", "ット", "ッツ", "ッウ", "トゥ", "テョ", "テュ", "ウー", "ワー", "ウェ", "ヱー", "ウィ", "ヰー", "ウォ", "ヲー", "ッワ", "ッヱ", "ッヰ", "ッヲ", "ヤー", "イェ", "ヨー", "ユー", "ッヤ", "ッヨ", "ッユ", "バ", "ベ", "ビ", "ボ", "ブ", "ダ", "デ", "ド", "ヅ", "ガ", "ゲ", "ギ", "ゴ", "グ", "ジ", "パ", "ペ", "ピ", "ポ", "プ", "ヴ", "ザ", "ゼ", "ヂ", "ゾ", "ズ", "ー", "ア", "ァ", "チ", "エ", "ェ", "フ", "ハ", "ヘ", "ヒ", "ホ", "イ", "ィ", "カ", "ケ", "キ", "コ", "ク", "マ", "メ", "ミ", "モ", "ム", "ン", "ナ", "ネ", "ニ", "ノ", "ヌ", "オ", "ォ", "ラ", "レ", "リ", "ロ", "ル", "サ", "セ", "シ", "ソ", "ス", "ッ", "タ", "テ", "ト", "ツ", "ウ", "ゥ", "ワ", "ヱ", "ヰ", "ヲ", "ヤ", "ャ", "ヨ", "ョ", "ユ", "ュ", "ッビャー", "ッビェー", "ッビョー", "ッビュー", "ッディー", "ッドゥー", "ッデュー", "ッグァー", "ッグェー", "ッグィー", "ッグォー", "ッギャー", "ッギェー", "ッギョー", "ッギュー", "ッジャー", "ッジェー", "ッジョー", "ッジュー", "ッンバー", "ッンベー", "ッンビー", "ッンボー", "ッンブー", "ッンパー", "ッンペー", "ッンピー", "ッンポー", "ッンプー", "ッピャー", "ッピェー", "ッピョー", "ッピュー", "ッヴァー", "ッヴェー", "ッヴィー", "ッヴォー", "ッヴョー", "ッヴュー", "ッズィー", "ッヂャー", "ッヂョー", "ッヂュー", "ッファー", "ッフェー", "ッフィー", "ッフォー", "ッフャー", "ッフョー", "ッフュー", "ッヒャー", "ッヒェー", "ッヒョー", "ッヒュー", "ックァー", "ックェー", "ックィー", "ックォー", "ッキャー", "ッキェー", "ッキョー", "ッキュー", "ッンマー", "ッンメー", "ッンミー", "ッンモー", "ッンムー", "ッミャー", "ッミェー", "ッミョー", "ッミュー", "ッンアー", "ッンエー", "ッンイー", "ッンナー", "ッンネー", "ッンニー", "ッンノー", "ッンヌー", "ッンオー", "ッンウー", "ッニャー", "ッニェー", "ッニェー", "ッニョー", "ッニュー", "ッリャー", "ッリェー", "ッリョー", "ッリュー", "ッシャー", "ッシェー", "ッシェー", "ッショー", "ッシュー", "ッスィー", "ッチャー", "ッチェー", "ッチェー", "ッチョー", "ッチュー", "ッティー", "ッオオー", "ッオウー", "ッツァー", "ッツェー", "ッツィー", "ッツォー", "ットゥー", "ッテュー", "ッウェー", "ッウィー", "ッウォー", "ッイェー", "ッバー", "ッベー", "ッビー", "ッボー", "ッブー", "ッビャ", "ッビェ", "ッビョ", "ッビュ", "ビャー", "ビェー", "ビョー", "ビュー", "ッダー", "ッデー", "ッディ", "ッドー", "ッドゥ", "ッデュ", "ッヅー", "ディー", "ドゥー", "デュー", "ッガー", "ッゲー", "ッギー", "ッゴー", "ッグー", "ッグァ", "ッグェ", "ッグィ", "ッグォ", "ッギャ", "ッギェ", "ッギョ", "ッギュ", "グァー", "グェー", "グィー", "グォー", "ギャー", "ギェー", "ギョー", "ギュー", "ジャー", "ジェー", "ッジャ", "ッジェ", "ッジー", "ッジョ", "ッジュ", "ジョー", "ジュー", "ンバー", "ンベー", "ンビー", "ンボー", "ンブー", "ッンバ", "ッンベ", "ッンビ", "ッンボ", "ッンブ", "ッンパ", "ッンペ", "ッンピ", "ッンポ", "ッンプ", "ンパー", "ンペー", "ンピー", "ンポー", "ンプー", "ッパー", "ッペー", "ッピー", "ッポー", "ップー", "ッピャ", "ッピェ", "ッピョ", "ッピュ", "ピャー", "ピェー", "ピョー", "ピュー", "ヴァー", "ヴェー", "ヴィー", "ヴォー", "ッヴァ", "ッヴェ", "ッヴィ", "ッヴォ", "ッヴー", "ッヴョ", "ッヴュ", "ヴョー", "ヴュー", "ズィー", "ヂャー", "ヂョー", "ヂュー", "ッザー", "ッゼー", "ッズィ", "ッヂー", "ッゾー", "ッズー", "ッヂャ", "ッヂョ", "ッヂュ", "チャー", "チェー", "チェー", "チョー", "チュー", "ファー", "フェー", "ッファ", "ッフェ", "ッフィ", "ッフォ", "ッフー", "ッフャ", "ッフョ", "ッフュ", "フィー", "フォー", "フャー", "フョー", "フュー", "ッハー", "ッヘー", "ッヒー", "ッホー", "ッヒャ", "ッヒェ", "ッヒョ", "ッヒュ", "ヒャー", "ヒェー", "ヒョー", "ヒュー", "ッカー", "ッケー", "ッキー", "ッコー", "ックー", "ックァ", "ックェ", "ックィ", "ックォ", "ッキャ", "ッキェ", "ッキョ", "ッキュ", "クァー", "クェー", "クィー", "クォー", "キャー", "キェー", "キョー", "キュー", "ンマー", "ッマー", "ンメー", "ッメー", "ンミー", "ッミー", "ッンマ", "ッンメ", "ッンミ", "ッンモ", "ッンム", "ンモー", "ッモー", "ンムー", "ッムー", "ッミャ", "ッミェ", "ッミョ", "ッミュ", "ミャー", "ミェー", "ミョー", "ミュー", "ンアー", "ッナー", "ンエー", "ッネー", "ンイー", "ッニー", "ッンア", "ンナー", "ッンエ", "ンネー", "ッンイ", "ンニー", "ッンナ", "ッンネ", "ッンニ", "ッンノ", "ッンヌ", "ッンオ", "ンノー", "ッンウ", "ンヌー", "ンオー", "ッノー", "ンウー", "ッヌー", "ッニャ", "ッニェ", "ッニョ", "ッニュ", "ニャー", "ニェー", "ニョー", "ニュー", "オオー", "オウー", "ッラー", "ッレー", "ッリー", "ッロー", "ッルー", "ッリャ", "ッリェ", "ッリョ", "ッリュ", "リャー", "リェー", "リョー", "リュー", "シャー", "シェー", "ショー", "シュー", "スィー", "ッサー", "ッセー", "ッシャ", "ッシェ", "ッシー", "ッショ", "ッシュ", "ッスィ", "ッソー", "ッスー", "ッチャ", "ッチェ", "ッチェ", "ッチー", "ッチョ", "ッチュ", "ティー", "ツァー", "ツェー", "ツィー", "ツォー", "ッアー", "ッター", "ッエー", "ッテー", "ッティ", "ッイー", "ッオオ", "ッオウ", "ッオー", "ットー", "ッツァ", "ッツェ", "ッツィ", "ッツォ", "ッツー", "ットゥ", "ッウー", "ッテュ", "トゥー", "テュー", "ウェー", "ウィー", "ウォー", "ッワー", "ッウェ", "ッヱー", "ッウィ", "ッヰー", "ッウォ", "ッヲー", "イェー", "イェー", "ッヤー", "ッイェ", "ッイェ", "ッヨー", "ッユー", "バー", "ッバ", "ッベ", "ッビ", "ッボ", "ッブ", "ベー", "ビー", "ボー", "ブー", "ビャ", "ビェ", "ビィ", "ビョ", "ビュ", "ダー", "ッダ", "ッデ", "ッド", "ッヅ", "デー", "ディ", "ドー", "ドゥ", "ドォ", "デャ", "デョ", "デュ", "ヅー", "ガー", "ゲー", "ッガ", "ッゲ", "ッギ", "ッゴ", "ッグ", "ギー", "ゴー", "グー", "グァ", "グェ", "グィ", "グォ", "ギャ", "ギェ", "ギィ", "ギョ", "ギュ", "ジャ", "ジェ", "ジー", "ッジ", "ジョ", "ジュ", "ジィ", "ンバ", "ンベ", "ンビ", "ンボ", "ンブ", "ンパ", "ンペ", "ンピ", "ンポ", "ンプ", "パー", "ペー", "ピー", "ポー", "ッパ", "ッペ", "ッピ", "ッポ", "ップ", "プー", "ピャ", "ピェ", "ピィ", "ピョ", "ピュ", "ヴァ", "ヴェ", "ヴィ", "ヴォ", "ヴー", "ッヴ", "ヴャ", "ヴョ", "ヴュ", "ザー", "ゼー", "ズィ", "ヂー", "ゾー", "ズー", "ヂャ", "ヂョ", "ヂュ", "ッザ", "ッゼ", "ッヂ", "ッゾ", "ッズ", "アー", "チャ", "チェ", "チー", "チョ", "チュ", "エー", "ファ", "フェ", "ッフ", "フィ", "フォ", "フー", "フゥ", "フャ", "フョ", "フュ", "ハー", "ヘー", "ッハ", "ッヘ", "ッヒ", "ッホ", "ヒー", "ホー", "ヒャ", "ヒェ", "ヒィ", "ヒョ", "ヒュ", "イー", "カー", "ケー", "キー", "ッカ", "ッケ", "ッキ", "ッコ", "ック", "コー", "クー", "クァ", "クェ", "クィ", "クォ", "キャ", "キェ", "キィ", "キョ", "キュ", "マー", "メー", "ミー", "ンマ", "ッマ", "ンメ", "ッメ", "ンミ", "ッミ", "ンモ", "ッモ", "ンム", "ッム", "モー", "ムー", "ミャ", "ミェ", "ミィ", "ミョ", "ミュ", "ナー", "ネー", "ニー", "ンア", "ッナ", "ンエ", "ッネ", "ンイ", "ッニ", "ンナ", "ンネ", "ンニ", "ンノ", "ンヌ", "ンオ", "ッノ", "ンウ", "ッヌ", "ノー", "ヌー", "ニャ", "ニェ", "ニィ", "ニョ", "ニュ", "オオ", "オウ", "オー", "クャ", "クョ", "クュ", "ラー", "レー", "リー", "ロー", "ッラ", "ッレ", "ッリ", "ッロ", "ッル", "ルー", "リャ", "リェ", "リィ", "リョ", "リュ", "サー", "セー", "シャ", "シェ", "シー", "ショ", "シュ", "スィ", "ソー", "ッサ", "ッセ", "ッシ", "ッソ", "ッス", "スー", "スァ", "スォ", "スゥ", "ター", "ッチ", "テー", "ティ", "トー", "ツァ", "ツェ", "ツィ", "ツォ", "ツー", "ッア", "ッタ", "ッエ", "ッテ", "ッイ", "ッオ", "ット", "ッツ", "ッウ", "トゥ", "テョ", "テュ", "ウー", "ワー", "ウェ", "ヱー", "ウィ", "ヰー", "ウォ", "ヲー", "ッワ", "ッヱ", "ッヰ", "ッヲ", "ヤー", "イェ", "ヨー", "ユー", "ッヤ", "ッヨ", "ッユ", "バ", "ベ", "ビ", "ボ", "ブ", "ダ", "デ", "ド", "ヅ", "ガ", "ゲ", "ギ", "ゴ", "グ", "ジ", "パ", "ペ", "ピ", "ポ", "プ", "ヴ", "ザ", "ゼ", "ヂ", "ゾ", "ズ", "ー", "ア", "ァ", "チ", "エ", "ェ", "フ", "ハ", "ヘ", "ヒ", "ホ", "イ", "ィ", "カ", "ケ", "キ", "コ", "ク", "マ", "メ", "ミ", "モ", "ム", "ン", "ナ", "ネ", "ニ", "ノ", "ヌ", "オ", "ォ", "ラ", "レ", "リ", "ロ", "ル", "サ", "セ", "シ", "ソ", "ス", "ッ", "タ", "テ", "ト", "ツ", "ウ", "ゥ", "ワ", "ヱ", "ヰ", "ヲ", "ヤ", "ャ", "ヨ", "ョ", "ユ", "ュ")
	ローマ字 = Array("bbyaa", "bbyee", "bbyoo", "bbyuu", "ddii", "dduu", "ddyuu", "ggwaa", "ggwee", "ggwii", "ggwoo", "ggyaa", "ggyee", "ggyoo", "ggyuu", "jjaa", "jjee", "jjoo", "jjuu", "mmbaa", "mmbee", "mmbii", "mmboo", "mmbuu", "mmpaa", "mmpee", "mmpii", "mmpoo", "mmpuu", "ppyaa", "ppyee", "ppyoo", "ppyuu", "vvaa", "vvee", "vvii", "vvoo", "vvyoo", "vvyuu", "zz'ii", "zzyaa", "zzyoo", "zzyuu", "ffaa", "ffee", "ffii", "ffoo", "ffyaa", "ffyoo", "ffyuu", "hhyaa", "hhyee", "hhyoo", "hhyuu", "kkwaa", "kkwee", "kkwii", "kkwoo", "kkyaa", "kkyee", "kkyoo", "kkyuu", "mmmaa", "mmmee", "mmmii", "mmmoo", "mmmuu", "mmyaa", "mmyee", "mmyoo", "mmyuu", "nnnaa", "nnnee", "nnnii", "nnnnaa", "nnnnee", "nnnnii", "nnnnoo", "nnnnuu", "nnnoo", "nnnuu", "nnyaa", "nnyee", "nnyee", "nnyoo", "nnyuu", "rryaa", "rryee", "rryoo", "rryuu", "sshaa", "sshee", "sshee", "sshoo", "sshuu", "ss'ii", "tchaa", "tchee", "tchee", "tchoo", "tchuu", "ttii", "ttohh", "ttohh", "ttsaa", "ttsee", "ttsii", "ttsoo", "ttuu", "ttyuu", "wwee", "wwii", "wwoo", "yyee", "bbaa", "bbee", "bbii", "bboo", "bbuu", "bbya", "bbye", "bbyo", "bbyu", "byaa", "byee", "byoo", "byuu", "ddaa", "ddee", "ddi", "ddoo", "ddu", "ddyu", "ddzuu", "dii", "duu", "dyuu", "ggaa", "ggee", "ggii", "ggoo", "gguu", "ggwa", "ggwe", "ggwi", "ggwo", "ggya", "ggye", "ggyo", "ggyu", "gwaa", "gwee", "gwii", "gwoo", "gyaa", "gyee", "gyoo", "gyuu", "jaa", "jee", "jja", "jje", "jjii", "jjo", "jju", "joo", "juu", "mbaa", "mbee", "mbii", "mboo", "mbuu", "mmba", "mmbe", "mmbi", "mmbo", "mmbu", "mmpa", "mmpe", "mmpi", "mmpo", "mmpu", "mpaa", "mpee", "mpii", "mpoo", "mpuu", "ppaa", "ppee", "ppii", "ppoo", "ppuu", "ppya", "ppye", "ppyo", "ppyu", "pyaa", "pyee", "pyoo", "pyuu", "vaa", "vee", "vii", "voo", "vva", "vve", "vvi", "vvo", "vvuu", "vvyo", "vvyu", "vyoo", "vyuu", "z'ii", "zyaa", "zyoo", "zyuu", "zzaa", "zzee", "zz'i", "zzjii", "zzoo", "zzuu", "zzya", "zzyo", "zzyu", "chaa", "chee", "chee", "choo", "chuu", "faa", "fee", "ffa", "ffe", "ffi", "ffo", "ffuu", "ffya", "ffyo", "ffyu", "fii", "foo", "fyaa", "fyoo", "fyuu", "hhaa", "hhee", "hhii", "hhoo", "hhya", "hhye", "hhyo", "hhyu", "hyaa", "hyee", "hyoo", "hyuu", "kkaa", "kkee", "kkii", "kkoo", "kkuu", "kkwa", "kkwe", "kkwi", "kkwo", "kkya", "kkye", "kkyo", "kkyu", "kwaa", "kwee", "kwii", "kwoo", "kyaa", "kyee", "kyoo", "kyuu", "mmaa", "mmaa", "mmee", "mmee", "mmii", "mmii", "mmma", "mmme", "mmmi", "mmmo", "mmmu", "mmoo", "mmoo", "mmuu", "mmuu", "mmya", "mmye", "mmyo", "mmyu", "myaa", "myee", "myoo", "myuu", "nnaa", "nnaa", "nnee", "nnee", "nnii", "nnii", "nnna", "nnnaa", "nnne", "nnnee", "nnni", "nnnii", "nnnna", "nnnne", "nnnni", "nnnno", "nnnnu", "nnno", "nnnoo", "nnnu", "nnnuu", "nnoo", "nnoo", "nnuu", "nnuu", "nnya", "nnye", "nnyo", "nnyu", "nyaa", "nyee", "nyoo", "nyuu", "ohh", "ohh", "rraa", "rree", "rrii", "rroo", "rruu", "rrya", "rrye", "rryo", "rryu", "ryaa", "ryee", "ryoo", "ryuu", "shaa", "shee", "shoo", "shuu", "s'ii", "ssaa", "ssee", "ssha", "sshe", "sshii", "ssho", "sshu", "ss'i", "ssoo", "ssuu", "tcha", "tche", "tche", "tchii", "tcho", "tchu", "tii", "tsaa", "tsee", "tsii", "tsoo", "ttaa", "ttaa", "ttee", "ttee", "tti", "ttii", "ttoh", "ttoh", "ttoo", "ttoo", "ttsa", "ttse", "ttsi", "ttso", "ttsuu", "ttu", "ttuu", "ttyu", "tuu", "tyuu", "wee", "wii", "woo", "wwaa", "wwe", "wwee", "wwi", "wwii", "wwo", "wwoo", "yee", "yee", "yyaa", "yye", "yye", "yyoo", "yyuu", "baa", "bba", "bbe", "bbi", "bbo", "bbu", "bee", "bii", "boo", "buu", "bya", "bye", "byi", "byo", "byu", "daa", "dda", "dde", "ddo", "ddzu", "dee", "di", "doo", "du", "dwo", "dya", "dyo", "dyu", "dzuu", "gaa", "gee", "gga", "gge", "ggi", "ggo", "ggu", "gii", "goo", "guu", "gwa", "gwe", "gwi", "gwo", "gya", "gye", "gyi", "gyo", "gyu", "ja", "je", "jii", "jji", "jo", "ju", "jyi", "mba", "mbe", "mbi", "mbo", "mbu", "mpa", "mpe", "mpi", "mpo", "mpu", "paa", "pee", "pii", "poo", "ppa", "ppe", "ppi", "ppo", "ppu", "puu", "pya", "pye", "pyi", "pyo", "pyu", "va", "ve", "vi", "vo", "vuu", "vvu", "vya", "vyo", "vyu", "zaa", "zee", "z'i", "zjii", "zoo", "zuu", "zya", "zyo", "zyu", "zza", "zze", "zzji", "zzo", "zzu", "aa", "cha", "che", "chii", "cho", "chu", "ee", "fa", "fe", "ffu", "fi", "fo", "fuu", "fwu", "fya", "fyo", "fyu", "haa", "hee", "hha", "hhe", "hhi", "hho", "hii", "hoo", "hya", "hye", "hyi", "hyo", "hyu", "ii", "kaa", "kee", "kii", "kka", "kke", "kki", "kko", "kku", "koo", "kuu", "kwa", "kwe", "kwi", "kwo", "kya", "kye", "kyi", "kyo", "kyu", "maa", "mee", "mii", "mma", "mma", "mme", "mme", "mmi", "mmi", "mmo", "mmo", "mmu", "mmu", "moo", "muu", "mya", "mye", "myi", "myo", "myu", "naa", "nee", "nii", "nna", "nna", "nne", "nne", "nni", "nni", "nnna", "nnne", "nnni", "nnno", "nnnu", "nno", "nno", "nnu", "nnu", "noo", "nuu", "nya", "nye", "nyi", "nyo", "nyu", "oh", "oh", "oo", "qya", "qyo", "qyu", "raa", "ree", "rii", "roo", "rra", "rre", "rri", "rro", "rru", "ruu", "rya", "rye", "ryi", "ryo", "ryu", "saa", "see", "sha", "she", "shii", "sho", "shu", "s'i", "soo", "ssa", "sse", "sshi", "sso", "ssu", "suu", "swa", "swo", "swu", "taa", "tchi", "tee", "ti", "too", "tsa", "tse", "tsi", "tso", "tsuu", "tta", "tta", "tte", "tte", "tti", "tto", "tto", "ttsu", "ttu", "tu", "tyo", "tyu", "uu", "waa", "we", "wee", "wi", "wii", "wo", "woo", "wwa", "wwe", "wwi", "wwo", "yaa", "ye", "yoo", "yuu", "yya", "yyo", "yyu", "ba", "be", "bi", "bo", "bu", "da", "de", "do", "dzu", "ga", "ge", "gi", "go", "gu", "ji", "pa", "pe", "pi", "po", "pu", "vu", "za", "ze", "zi", "zo", "zu", "-", "a", "a", "chi", "e", "e", "fu", "ha", "he", "hi", "ho", "i", "i", "ka", "ke", "ki", "ko", "ku", "ma", "me", "mi", "mo", "mu", "n", "na", "ne", "ni", "no", "nu", "o", "o", "ra", "re", "ri", "ro", "ru", "sa", "se", "shi", "so", "su", "t", "ta", "te", "to", "tsu", "u", "u", "wa", "we", "wi", "wo", "ya", "ya", "yo", "yo", "yu", "yu", "bbyaa", "bbyee", "bbyoo", "bbyuu", "ddii", "dduu", "ddyuu", "ggwaa", "ggwee", "ggwii", "ggwoo", "ggyaa", "ggyee", "ggyoo", "ggyuu", "jjaa", "jjee", "jjoo", "jjuu", "mmbaa", "mmbee", "mmbii", "mmboo", "mmbuu", "mmpaa", "mmpee", "mmpii", "mmpoo", "mmpuu", "ppyaa", "ppyee", "ppyoo", "ppyuu", "vvaa", "vvee", "vvii", "vvoo", "vvyoo", "vvyuu", "zz'ii", "zzyaa", "zzyoo", "zzyuu", "ffaa", "ffee", "ffii", "ffoo", "ffyaa", "ffyoo", "ffyuu", "hhyaa", "hhyee", "hhyoo", "hhyuu", "kkwaa", "kkwee", "kkwii", "kkwoo", "kkyaa", "kkyee", "kkyoo", "kkyuu", "mmmaa", "mmmee", "mmmii", "mmmoo", "mmmuu", "mmyaa", "mmyee", "mmyoo", "mmyuu", "nnnaa", "nnnee", "nnnii", "nnnnaa", "nnnnee", "nnnnii", "nnnnoo", "nnnnuu", "nnnoo", "nnnuu", "nnyaa", "nnyee", "nnyee", "nnyoo", "nnyuu", "rryaa", "rryee", "rryoo", "rryuu", "sshaa", "sshee", "sshee", "sshoo", "sshuu", "ss'ii", "tchaa", "tchee", "tchee", "tchoo", "tchuu", "ttii", "ttohh", "ttohh", "ttsaa", "ttsee", "ttsii", "ttsoo", "ttuu", "ttyuu", "wwee", "wwii", "wwoo", "yyee", "bbaa", "bbee", "bbii", "bboo", "bbuu", "bbya", "bbye", "bbyo", "bbyu", "byaa", "byee", "byoo", "byuu", "ddaa", "ddee", "ddi", "ddoo", "ddu", "ddyu", "ddzuu", "dii", "duu", "dyuu", "ggaa", "ggee", "ggii", "ggoo", "gguu", "ggwa", "ggwe", "ggwi", "ggwo", "ggya", "ggye", "ggyo", "ggyu", "gwaa", "gwee", "gwii", "gwoo", "gyaa", "gyee", "gyoo", "gyuu", "jaa", "jee", "jja", "jje", "jjii", "jjo", "jju", "joo", "juu", "mbaa", "mbee", "mbii", "mboo", "mbuu", "mmba", "mmbe", "mmbi", "mmbo", "mmbu", "mmpa", "mmpe", "mmpi", "mmpo", "mmpu", "mpaa", "mpee", "mpii", "mpoo", "mpuu", "ppaa", "ppee", "ppii", "ppoo", "ppuu", "ppya", "ppye", "ppyo", "ppyu", "pyaa", "pyee", "pyoo", "pyuu", "vaa", "vee", "vii", "voo", "vva", "vve", "vvi", "vvo", "vvuu", "vvyo", "vvyu", "vyoo", "vyuu", "z'ii", "zyaa", "zyoo", "zyuu", "zzaa", "zzee", "zz'i", "zzjii", "zzoo", "zzuu", "zzya", "zzyo", "zzyu", "chaa", "chee", "chee", "choo", "chuu", "faa", "fee", "ffa", "ffe", "ffi", "ffo", "ffuu", "ffya", "ffyo", "ffyu", "fii", "foo", "fyaa", "fyoo", "fyuu", "hhaa", "hhee", "hhii", "hhoo", "hhya", "hhye", "hhyo", "hhyu", "hyaa", "hyee", "hyoo", "hyuu", "kkaa", "kkee", "kkii", "kkoo", "kkuu", "kkwa", "kkwe", "kkwi", "kkwo", "kkya", "kkye", "kkyo", "kkyu", "kwaa", "kwee", "kwii", "kwoo", "kyaa", "kyee", "kyoo", "kyuu", "mmaa", "mmaa", "mmee", "mmee", "mmii", "mmii", "mmma", "mmme", "mmmi", "mmmo", "mmmu", "mmoo", "mmoo", "mmuu", "mmuu", "mmya", "mmye", "mmyo", "mmyu", "myaa", "myee", "myoo", "myuu", "nnaa", "nnaa", "nnee", "nnee", "nnii", "nnii", "nnna", "nnnaa", "nnne", "nnnee", "nnni", "nnnii", "nnnna", "nnnne", "nnnni", "nnnno", "nnnnu", "nnno", "nnnoo", "nnnu", "nnnuu", "nnoo", "nnoo", "nnuu", "nnuu", "nnya", "nnye", "nnyo", "nnyu", "nyaa", "nyee", "nyoo", "nyuu", "ohh", "ohh", "rraa", "rree", "rrii", "rroo", "rruu", "rrya", "rrye", "rryo", "rryu", "ryaa", "ryee", "ryoo", "ryuu", "shaa", "shee", "shoo", "shuu", "s'ii", "ssaa", "ssee", "ssha", "sshe", "sshii", "ssho", "sshu", "ss'i", "ssoo", "ssuu", "tcha", "tche", "tche", "tchii", "tcho", "tchu", "tii", "tsaa", "tsee", "tsii", "tsoo", "ttaa", "ttaa", "ttee", "ttee", "tti", "ttii", "ttoh", "ttoh", "ttoo", "ttoo", "ttsa", "ttse", "ttsi", "ttso", "ttsuu", "ttu", "ttuu", "ttyu", "tuu", "tyuu", "wee", "wii", "woo", "wwaa", "wwe", "wwee", "wwi", "wwii", "wwo", "wwoo", "yee", "yee", "yyaa", "yye", "yye", "yyoo", "yyuu", "baa", "bba", "bbe", "bbi", "bbo", "bbu", "bee", "bii", "boo", "buu", "bya", "bye", "byi", "byo", "byu", "daa", "dda", "dde", "ddo", "ddzu", "dee", "di", "doo", "du", "dwo", "dya", "dyo", "dyu", "dzuu", "gaa", "gee", "gga", "gge", "ggi", "ggo", "ggu", "gii", "goo", "guu", "gwa", "gwe", "gwi", "gwo", "gya", "gye", "gyi", "gyo", "gyu", "ja", "je", "jii", "jji", "jo", "ju", "jyi", "mba", "mbe", "mbi", "mbo", "mbu", "mpa", "mpe", "mpi", "mpo", "mpu", "paa", "pee", "pii", "poo", "ppa", "ppe", "ppi", "ppo", "ppu", "puu", "pya", "pye", "pyi", "pyo", "pyu", "va", "ve", "vi", "vo", "vuu", "vvu", "vya", "vyo", "vyu", "zaa", "zee", "z'i", "zjii", "zoo", "zuu", "zya", "zyo", "zyu", "zza", "zze", "zzji", "zzo", "zzu", "aa", "cha", "che", "chii", "cho", "chu", "ee", "fa", "fe", "ffu", "fi", "fo", "fuu", "fwu", "fya", "fyo", "fyu", "haa", "hee", "hha", "hhe", "hhi", "hho", "hii", "hoo", "hya", "hye", "hyi", "hyo", "hyu", "ii", "kaa", "kee", "kii", "kka", "kke", "kki", "kko", "kku", "koo", "kuu", "kwa", "kwe", "kwi", "kwo", "kya", "kye", "kyi", "kyo", "kyu", "maa", "mee", "mii", "mma", "mma", "mme", "mme", "mmi", "mmi", "mmo", "mmo", "mmu", "mmu", "moo", "muu", "mya", "mye", "myi", "myo", "myu", "naa", "nee", "nii", "nna", "nna", "nne", "nne", "nni", "nni", "nnna", "nnne", "nnni", "nnno", "nnnu", "nno", "nno", "nnu", "nnu", "noo", "nuu", "nya", "nye", "nyi", "nyo", "nyu", "oh", "oh", "oo", "qya", "qyo", "qyu", "raa", "ree", "rii", "roo", "rra", "rre", "rri", "rro", "rru", "ruu", "rya", "rye", "ryi", "ryo", "ryu", "saa", "see", "sha", "she", "shii", "sho", "shu", "s'i", "soo", "ssa", "sse", "sshi", "sso", "ssu", "suu", "swa", "swo", "swu", "taa", "tchi", "tee", "ti", "too", "tsa", "tse", "tsi", "tso", "tsuu", "tta", "tta", "tte", "tte", "tti", "tto", "tto", "ttsu", "ttu", "tu", "tyo", "tyu", "uu", "waa", "we", "wee", "wi", "wii", "wo", "woo", "wwa", "wwe", "wwi", "wwo", "yaa", "ye", "yoo", "yuu", "yya", "yyo", "yyu", "ba", "be", "bi", "bo", "bu", "da", "de", "do", "dzu", "ga", "ge", "gi", "go", "gu", "ji", "pa", "pe", "pi", "po", "pu", "vu", "za", "ze", "zi", "zo", "zu", "-", "a", "a", "chi", "e", "e", "fu", "ha", "he", "hi", "ho", "i", "i", "ka", "ke", "ki", "ko", "ku", "ma", "me", "mi", "mo", "mu", "n", "na", "ne", "ni", "no", "nu", "o", "o", "ra", "re", "ri", "ro", "ru", "sa", "se", "shi", "so", "su", "t", "ta", "te", "to", "tsu", "u", "u", "wa", "we", "wi", "wo", "ya", "ya", "yo", "yo", "yu", "yu")
	'2007/09/15
	
	For i = 0 To UBound(カナ)
		文字列 = Replace(文字列, カナ(i), ローマ字(i))
	Next
	カナ→ローマ字 = 文字列
End Function

'**********************************************************
'★★★★メイン★★★★
'**********************************************************
Dim sClipBoard, S, ExcelOn
Dim  Excel, Arr

HotVBS.Sleep 200
sClipBoard = HotVBS.ClipBoard	'既存のクリップボードの内容を、sClipBoardに退避。
HotVBS.ClipBoard = ""	 'クリップボードの内容をクリア

'**************************************
'Excelの起動判定(エディタのクラス名のライブラリを使用)

ExcelOn = 0

If InStr(HotVBS.Class, "EXCEL") = 1 Then
	ExcelOn = 1
End If

	? ExcelOn

'**************************************
HotVBS.Sleep 1000   'エラーを出さないように、0.5秒待たす

HotVBS.Copy		'選択中のデータを、クリップボードにコピー
S = HotVBS.ClipBoard   ? 'クリップボードに取り込んだ選択中のデータを、変数Sに格納。

If ExcelOn = 1 Then
	HotVBS.Sleep 300   'エラーを出さないように、0.3秒待たす

	'Excelが起動中の場合は、選択中のセル範囲を、変換対象として、配列 Arr に格納する。
	'参考にさせていただいたサイト:Fioの素敵な日々
	'http://d.hatena.ne.jp/Fio/searchdiary?word=*%5BFileMaker%5D

	Set Arr = GetObject(, "Excel.Application").Selection
	
	HotVBS.Sleep 200   'エラーを出さないように、0.2秒待たす
	
		? UBound(Arr)
	For j = 1 To UBound(Arr, 1)
		For k = 1 To UBound(Arr, 2)
				? Arr(1, 1)
				? Arr(2, 1)
				? j
				? k
				? Arr(j, k)
			Arr(j, k) = カナ→ローマ字(Arr(j, k))    ?
		Next
	Next
	
	Set Excel = CreateObject("Excel.Application")
	Excel.CutCopyMode = False
	    
	Set Arr = Nothing
	Set Excel = Nothing
	
ElseIf S = ""  Then 
	'Excelが起動していなくて、選択中のデータが無い場合
	HotVBS.SelAll 'アクティブな画面で、全選択する
	HotVBS.Copy   '全選択した内容をコピー
	S = HotVBS.ClipBoard		'全選択した内容を、変換対象とてし、変数Sに格納
	S = カナ→ローマ字(S)  'カナ→ローマ字変換
	HotVBS.ClipBoard = S  'ローマ字変換後の文字列を、クリップボードに戻す
	HotVBS.Past           'クリップボードのデータを、起動中の画面に貼付け
	
Else
	'Excelが起動していなくて、選択範囲から、文字列を取得できた場合
	S = カナ→ローマ字(S)  'カナ→ローマ字変換
	HotVBS.ClipBoard = S  'ローマ字変換後の文字列を、クリップボードに戻す
	HotVBS.Past           'クリップボードのデータを、起動中の画面に貼付け
End If


HotVBS.ClipBoard = sClipBoard '退避してあったデータを、クリップボードに戻す
'****************************************************************


この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


一行の文字数を指定して行数をカウント


■経歴
2011/03/13:作成
2011/03/29:句読点のぶらさげを考慮

■用途:
テキスト形式のファイルを、指定の一行の文字数にした場合の行数をカウントする。
例えば、原稿用紙なら、一行の文字数は全角20文字、新聞の投稿なら、全角16文字です。
これらの文字数を前提にした行数を表示します。

■使い方
文字列を表示しているアプリケーションの上で、カウントしたい部分の文字列を選択状態にします。
ホットキー操作(デフォルトは、[CTRL]+[Enter])すると、
禁則処理(行末の句読点ぶら下げ)の考慮有無を聞いてきます。
現在のバージョンでは、物理改行の最後の文字のみ、句読点ぶら下げを考慮しています。
次に、一行の文字数を聞いてきます。
デフォルトは20文字になっていますが、20文字以外の場合は、ここに入力します。
結果が表示されます。


Option Explicit

Dim クリップボードの文字列
Dim 一行の文字数
Dim 文字数
Dim 行数
Dim 文字バイト数
Dim YesNo
Dim 禁則処理
Const 句読点 = "、。,.・?!゛゜ヽヾゝゞ々ー)]}」』!),.:;?]}。」、・ー゙゚"


YesNo = MsgBox ("禁則処理を考慮しますか?(はい:行末の句読点をぶら下げる、いいえ:句読点だけでも改行)禁則処理(句読点のぶら下げ)を選択")
YesNo ?
If YesNo = 6 Then 
	禁則処理 = "有り"
ElseIf  YesNo = 7 Then 
	禁則処理 = "無し"
Else 
	禁則処理 = "有り"
End If


ClipBoard.Clear                              'クリップボードをクリア
Editor.Copy                                  'エディタからクリップボードへコピー
クリップボードの文字列 = ClipBoard.Text      '変換対象の文字列
If クリップボードの文字列 <> "" Then

   一行の文字数 = InputBox("一行の文字数を指定して下さい。", "一行の文字数を指定", 20)
   行数 = 行数カウント(クリップボードの文字列, 一行の文字数)
   ? 行数
   文字数 = 行数 * 一行の文字数 ?
   MsgBox "一行の文字数:" & 一行の文字数 & vbNewLine _
      & "行数    :" & 行数 & vbNewLine _
      & "文字数   :" & 文字数 
End If

ClipBoard.Undo                               'クリップボードを戻す


Function 行数カウント(文字列, 数)
   Dim 配列
   Dim カウンタ
   Dim オリジナル行数
   Dim 最終行文字数
   
   配列 = Split(文字列, vbNewLine)
   行数カウント = 0
   ? UBound(配列)
   最終行文字数 = バイト数 (配列(UBound(配列)))
   If 最終行文字数 = 0 Then
      オリジナル行数 = UBound(配列) - 1
   Else
      オリジナル行数 = UBound(配列)
   End If

   For カウンタ = 0 To オリジナル行数
      ? 配列(カウンタ)
      文字バイト数 = バイト数(配列(カウンタ))
      If 文字バイト数 = 0 Then
         行数カウント = 行数カウント + 1
      Else
         If 禁則処理="有り" and 文字バイト数 Mod (数 * 2) <= 2 Then
            If InStr(句読点, Right(配列(カウンタ), 1)) > 0 Then
               ? 文字バイト数 Mod (数 * 2)
               ? Right(配列(カウンタ), 1)
               文字バイト数 = 文字バイト数 - 2
            End If
         End If   
         行数カウント = 行数カウント + Int(文字バイト数 / (数 * 2) + 0.99)
       End If
   Next 'カウンタ
End Function


' ***********************************************************
' VBScript でシフト JIS の文字列のバイト数を数える (unibon)
' ***********************************************************
' http://www.geocities.co.jp/siliconvalley/4334/unibon/asp/len.html
' VBScript には Len 関数や LenB 関数がありますが、これらはいずれも Unicode を基準として数えます。
' このため、文字列をシフト JIS で考えた場合のバイト数を求めることはできません。

Function バイト数(ByVal 文字列)
    Dim 数
    数 = 0
    Dim i
    For i = 0 To Len(文字列) - 1
        Dim 文字
        文字 = Mid(文字列, i + 1, 1)
        If (Asc(文字) And &HFF00) = 0 Then
            数 = 数 + 1
        Else
            数 = 数 + 2
        End If
    Next
    バイト数 = 数
End Function

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


ソースコード整形

 処理のポイント:
1.WinXP の場合は、「ファイルを開く」ダイアログ ボックスを使って、ファイルを選択できるように。
2.WinXP 以外の場合は、IEブラウザにファイルリストを表示して、選択できるように。
3.HotVBS.Title を使って、エディタ・タイトル を取得して、当該キーワード・ファイルのパスを切り替える。


'   ソースコード整形

'■用途:
'   テキスト・エディタで作成中の、プログラム・ソースを、
'   当該言語のキー・ワード・ファイルを使って整形します。

'■使い方:
'   HotVBSの「設定」→「スクリプト」→「ループ回数制限」を、
'   100,000もしくは、それ以上に増やして下さい。

'   エディタでソース・コードを開いて、当該画面をアクティブにした状態で、
'   ホットキーを押します。
'   (さくらエディタでは、自動全選択が効きません。
'   サクラエディタの場合は、前もって、全選択して、ホットキーして下さい。)

'   「ファイルを開く」ダイアログ ボックスが、表示されるので、
'   当該コードの予約語ファイルを指定して下さい。
'   (初回は、「ファイルを開く」ダイアログ ボックスが、
'   背面に出るので、探して下さい。)

'■整形内容:
'   @.キー・ワードの大文字・小文字を、
'      キー・ワード・ファイルに登録された形式にそろえます。
'      (""で囲まれた範囲は対象外)
'   A.算術記号の前後に、半角スペースを挿入します。
'      (""で囲まれた範囲は対象外)
'   B.行末の空白を削除します。(行末のタブは削除しません。)

'   今後の検討課題:
'      「ファイルを開く」ダイアログ ボックスを、前面に表示させる。
'      演算子の/の前後は空けるが、年月日の区切りの/の前後は空けない。(困難?)
'      演算子のマイナスと、文字列のハイホンの区分。(困難?)
'      数字の桁区切りのカンマと、変数や定数の区切りのカンマ。(困難?)

'■経歴
'   作成:2007/09/24
'   更新:2007/09/29
'   更新:2007/10/06 Vista 対応

'   Vistaでは、「ActiveXコンポーネントはオブジェクトを作成できません」、と表示されます。
'   このため、Vista では、IEブラウザにキー・ワード・ファイルの一覧を表示します。

'   このスクリプトを実行したことによる結果について、責任は持てませんので悪しからず。

'■謝辞
'   このスクリプトの、テキストをHTMLに変換して、IEで表示させる部分は、
'   結城圭介さんの「VBScript&JScript Tips」を参考にさせていただきました。
'   http://www.happy2-island.com/vbs/cafe02/capter00705.shtml
'   https://qiita.com/Q11Q/items/5eb56a7bf3c001fff24b


Option Explicit
'■カスタマイズ方法
'   下記は、テキスト・エディタの、タイトルと、
'   キー・ワード・ファイルの、登録フォルダ・パスと、拡張子です。
'   ご自分の環境に合わせて、修正して下さい。

Dim エディタ
ReDim エディタ(2, 3)  '[型が一致しません。]のエラーを出さない工夫。
   '私の「TEAD」の事例:
   エディタ(1, 1) = "TEAD"                               '★エディタ・タイトル HotVBS.Title
   エディタ(1, 2) = "C:\Program Files\TEAD\Env\"                             '★フォルダ・パス★
   エディタ(1, 3) = "TEAD予約語(*.rsv)|*.rsv|さくらKeyword(*.kwd)|*.kwd" '★拡張子★
   '私の「さくらエディタ」の事例:
   エディタ(2, 1) = "sakura"                              '★エディタ・タイトル HotVBS.Title
   エディタ(2, 2) = "C:\tool\テキストエディタ\Keyword\"                  '★フォルダ・パス★
   エディタ(2, 3) = "さくらKeyword(*.kwd)|*.kwd|TEAD予約語(*.rsv)|*.rsv" '★拡張子★

Dim エディタタイトル, フォルダパス, 拡張子
Dim 行数, Character, 文字列, W, 行, 全体行数, First , Last, i
Dim 既存内容, 変換対象
Dim KeyWords, 正規表現パターン
Dim OSバージョン
Dim ファイルシステムオブジェクト
Dim バッファ
Dim 入力ファイルフルパス
Dim IEオブジェクト
'*******************************************************
'★変換対象の文字列を、1行毎に分割して、行末の空白を削除★
Function 文字列変換(文字列)
'*******************************************************
      '1行ずつに分割
   文字列 = Split(文字列, VbCrLf)
   
      '全体行数を取得
   全体行数 = UBound(文字列)             ?
   
   '最終行の処理
   If 文字列(全体行数) = ""  Then
      全体行数 = 全体行数 - 1          ?
   End If
   
      '1行目から順に、最後の行まで
   For 行数 = 0 To 全体行数
      文字列(行数) = RTrim(文字列(行数))        '最終行の行末空白を削除
      文字列(行数) = 整形文字列(文字列(行数))   '変換対象の行を、1文字ずつ単語判定して、整形する
      文字列変換 = 文字列変換 & 文字列(行数) & VbCrLf
   Next
End Function

'*******************************************************
'★変換対象の行を、1文字ずつ単語判定して、整形する★
Function 整形文字列(行)
'*******************************************************

   Dim 単語, 引用文
   '空白を調節する文字:
   正規表現パターン = "[<>=&\+-]"
   '割り算の/も対象にしたいが、年月日の2007/09/と区分が面倒なので、とりあえず対象外。

   整形文字列 = ""
   単語 = ""
   First = 1
   ? 行
   ? Len(行)
   
   For Character = 1 To Len(行)
      ? Character
      If Mid(行, Character, 1) = Chr(34) Or Mid(行, Character, 1) = "「" Then
         '★引用符 " か「に出合ったとき
         
         '引用符の左側までを、単語として変数 単語 に格納
         単語 = Mid(行, First, Character - First)        ?
         
         '抽出した単語が、半角空白の場合、処理済の文字列の最後が空白の場合は、
         '処理済の右端空白を削除
         If 単語 = " " And 正規表現で文字列チェック(" | ", Right(整形文字列, 1)) Then
            整形文字列 = Left(整形文字列, Len(整形文字列) - 1)
         End If
         
         '単語を、予約語と照合して修正
         単語 = キーワード照合置換(単語)
         
         '処理済の文字列の後ろに、整形語の単語を付け加える
         ? 整形文字列 & "*"
         整形文字列 = 整形文字列 & 単語                 ?
         
         '引用符文字列の処理:次の引用符までを、引用部分として「引用文」に格納
         If Mid(行, Character, 1) = Chr(34) Then
            引用文 = Mid(行, Character, InStr(Right(行, Len(行) - Character), Chr(34)) + 1) ?
         ElseIf Mid(行, Character, 1) = "「" Then
            引用文 = Mid(行, Character, InStr(Right(行, Len(行) - Character), "」") + 1) ?
         End If
         
         '処理済の文字列の後ろに、引用部分を付け加える
         整形文字列 = 整形文字列 & 引用文            ?
         ? Character
         ? Len(引用文)
         
         '処理文字のカウンターを、引用部分の文字数だけ進める
         Character = Character + Len(引用文) - 1     ?
         ? Character
         
         First = Character + 1                          ?
                  
         If Character >= Len(行) Then
         '引用が、行の最後までなら、文字判定は完了
         '   First = First + 1                          ?
            Exit For
         End If
         
         '右側の処置
         If Character < Len(行) Then
            If 正規表現で文字列チェック(正規表現パターン, Mid(行, Character + 1, 1)) Then
            '右が演算子の場合、右側に空白を追加挿入
               整形文字列 = 整形文字列 & " "         ?
            End If
         End If

      ElseIf Mid(行, Character, 1) = ":" Then
      '★コロン:に出会ったら、以降の処理を放棄。(http:以下を生かすため。)
         単語 = Mid(行, First, Character - First)        ?
         整形文字列 = 整形文字列 & 単語 & Right(行, Len(行) - Character + 1)
         Character = Len(行)                             ?
         First = Character + 1                          ?

      ElseIf 正規表現で文字列チェック(" | |\(|\)|/|\.", Mid(行, Character, 1)) Then
      '★空白や、括弧に出会ったとき。演算子/とピリオド.もここで扱う。
         ? Character
         ? First
         単語 = Mid(行, First, Character - First)        ?
         
         単語 = キーワード照合置換(単語)
         
         単語 = 単語 & Mid(行, Character, 1)             ?
'         If 単語 = " " And 正規表現で文字列チェック(" | ", Right(整形文字列, 1)) Then
'            整形文字列 = Left(整形文字列, Len(整形文字列) - 1)
'         End If
         ? 整形文字列 & "*"
         整形文字列 = 整形文字列 & 単語                 ?
         
         '右側の処置
         If Character < Len(行) And 正規表現で文字列チェック("\(|\)|/|\.", Mid(行, Character, 1)) Then
            If 正規表現で文字列チェック(正規表現パターン, Mid(行, Character + 1, 1)) Then
            '右が演算子の場合、右側に空白を追加挿入
               整形文字列 = 整形文字列 & " "         ?
            End If
         End If

         First = Character + 1                          ?
      
      ElseIf 正規表現で文字列チェック(正規表現パターン, Mid(行, Character, 1)) Then
      '★演算子に出会ったとき
         単語 = RTrim(Mid(行, First, Character - First)) ?
         ? 単語 & "*"
         単語 = キーワード照合置換(単語)                   ?
         If 単語 = "" Then
            '既に、空白や括弧で、単語抽出ができているとき
            単語 = 単語  & Mid(行, Character, 1)        ?
         Else
            '単語の直後に演算子が来たとき、演算子の左に空白を挿入
            単語 = 単語 & " " & Mid(行, Character, 1)   ?
         End If
         
         整形文字列 = 整形文字列 & 単語
         
         '演算子の右側の処置
         If Character < Len(行) Then
            If 正規表現で文字列チェック(正規表現パターン, Mid(行, Character + 1, 1)) Then
            '演算子の右もまた演算子の場合、
            '右側も続けて取り込む。
               Character = Character + 1
               整形文字列 = 整形文字列 & Mid(行, Character, 1)    ?
               
               If Mid(行, Character + 1, 1) <> " " Then
               '右側が、半角空白でないときは、右側に空白を追加挿入
               整形文字列 = 整形文字列 & " "         ?
               End If
               
            ElseIf Mid(行, Character + 1, 1) <> " " Then
            '右側が、半角空白でないときは、右側に空白を追加挿入
               整形文字列 = 整形文字列 & " "         ?
            End If
         End If
         
         ? 整形文字列 & "*"
         First = Character + 1                          ?
         
      ElseIf Mid(行, Character, 1) = "," Then
      '★カンマに出会ったとき
         ? Character
         単語 = RTrim(Mid(行, First, Character - First)) ?
         ? 単語 & "*"
         単語 = キーワード照合置換(単語)                   ?
         
         単語 = 単語  & Mid(行, Character, 1)            ?
         
         整形文字列 = 整形文字列 & 単語                 ?
         
         'カンマの右側の処置
         If Character < Len(行) Then
            If Mid(行, Character + 1, 1) <> " " Then
            '右側が、半角空白でないときは、右側に空白を追加挿入
               整形文字列 = 整形文字列 & " "          ?
            End If
         End If
         
         ? 整形文字列 & "*"
         First = Character + 1                          ?
         
      End If
   Next
   
   ? First
   ? Len(行)
   単語 = Mid(行, First, Len(行) - First + 1)               ?
   
   単語 = キーワード照合置換(単語)                           ?

   整形文字列 = 整形文字列 & 単語                         ?
   
End Function


'*******************************************************
'★単語を、キー・ワードと照合して、予約語の大文字小文字を統一★
Function キーワード照合置換(単語)
'*******************************************************
   キーワード照合置換 = 単語                                 ?
   
   If Len(Trim(単語)) > 1 Then
   '2文字以上について、予約語と照合します。
      ? UBound(KeyWords)
      ? 単語
      ? Len(Trim(単語))

      For i = 0 To UBound(KeyWords)
         ? KeyWords(i)
         If Len(Trim(KeyWords(i))) > 1 Then
            '1 番目の文字からテキスト モードで比較を行います。
            If StrComp(Trim(単語), Trim(KeyWords(i)), 1) = 0 Then
               ? KeyWords(i)
               キーワード照合置換 = KeyWords(i)          ?
               Exit For
            End If
         End If
      Next
   End If
   
End Function

'**************************************************
'  ★★★正規表現で文字列チェック★★★
Function 正規表現で文字列チェック(正規表現パターン, 検索対象文字列)
   '正規表現パターン:正規表現
   '検索対象文字列:検索対象
'**************************************************

   Dim 正規表現オブジェクト
   Set 正規表現オブジェクト = New RegExp          ' 正規表現オブジェクトを作ります。
   正規表現オブジェクト.Pattern = 正規表現パターン       ?   ' パターンを設定します。
   正規表現オブジェクト.IgnoreCase = False        ' 大文字と小文字を区別するように設定します。
   ? 検索対象文字列
   正規表現で文字列チェック = 正規表現オブジェクト.Test(検索対象文字列)      ' 検索をテストします。
      '正規表現で文字列チェック = True '一致する文字列が 1 つ以上見つかりました。
      '正規表現で文字列チェック = False '一致する文字列が見つかりません。
   Set 正規表現オブジェクト = Nothing            'オブジェクトの開放

End Function

'**************************************************
'    ★★★メイン:選択範囲を変換★★★
'**************************************************

既存内容 = HotVBS.ClipBoard   'バックアップ用

HotVBS.ClipBoard = ""            'クリップボードをクリア
エディタタイトル = HotVBS.Title       ?
変換対象 = HotVBS.ClipBoard      '変換対象
? "*" & 変換対象  & "*"

HotVBS.Sleep 800   'エラーを出さないように、0.8秒待たす

HotVBS.Copy                     'エディタからクリップボードへコピー
変換対象 = HotVBS.ClipBoard      '変換対象
? "*" & 変換対象  & "*"

If 変換対象 = "" Then
   HotVBS.SelAll
   HotVBS.Copy
   変換対象 = HotVBS.ClipBoard      '変換対象
End If

If 変換対象 <> "" Then                 '変換対象の文字列がある場合は、
   ? 変換対象
   Call OS判定して分岐
    
   変換対象 = 文字列変換(変換対象)   '文字列変換処理 
   HotVBS.ClipBoard = 変換対象
   HotVBS.Past

End If

HotVBS.ClipBoard = 既存内容   'クリップボードを戻す

'*****************************************************
'★OSを判定して、ファイルの選択方法を変えて、キーワードを配列に登録★
Sub OS判定して分岐
'*****************************************************

   Dim ikey, Default

   'エディタを判定して、該当パスと、拡張子をセット
   ? UBound(エディタ, 1)
   
   For ikey = 1 To UBound(エディタ, 1)
      ? エディタタイトル
      ? エディタ(ikey, 1)
      If InStr(エディタタイトル, エディタ(ikey, 1)) <> 0 Then
         フォルダパス = エディタ(ikey, 2)     ?
         拡張子 = エディタ(ikey, 3)      ?
         Exit For
      Else
         フォルダパス = エディタ(Default, 2)     ?
         拡張子 = エディタ(Default, 3)      ?
      End If
   Next


   '対象ファイルを指定する方法が、OSによって違うため、Wordを使ってOSのバージョンを取得

   Dim Wordオブジェクト

   Set Wordオブジェクト = CreateObject ("Word.application").system
   HotVBS.Sleep(500)

   '   Windows 95=Windows 4.0
   '   Windows 2000   =NT 5.0
   '   Windows XP     =NT 5.1
   '   Windows Vista  =NT 6.0

   OSバージョン = Wordオブジェクト.Version

   Select Case OSバージョン
      Case 5.1 'Windows XP=NT 5.1
         OSバージョン = "XP"
         MsgBox Wordオブジェクト.OperatingSystem & " " _
         & Wordオブジェクト.Version & " " & OSバージョン & Chr(13) _
         & "「ファイルを開く」ダイアログ ボックスを使って、予約語ファイルを開いて下さい。" _
         , vbInformation, "あなたのお使いのWindows のバージョン"
      
         Wordオブジェクト.application.Quit
         Set Wordオブジェクト = Nothing

         Call XPファイルを開く
         
      Case Else  '
         OSバージョン = "XP以外"
         MsgBox Wordオブジェクト.OperatingSystem & " " _
         & Wordオブジェクト.Version & " " & OSバージョン & Chr(13) _
         & "ブラウザで、予約語ファイルリストを表示します。" & Chr(13) _
         , vbInformation, "あなたのお使いのWindows のバージョン"

         Wordオブジェクト.application.Quit
         Set Wordオブジェクト = Nothing

         Call ブラウザで指定フォルダのファイルを表示
         
   End Select
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   With ファイルシステムオブジェクト.OpenTextFile(入力ファイルフルパス)
      バッファ = .ReadAll                                    ?
      .Close
   End With

   Set ファイルシステムオブジェクト = Nothing

   KeyWords = Split(バッファ, VbCrLf)

End Sub

'**************************************************
'  ★★★キー・ワード・ファイルの読み込み★★★
Sub XPファイルを開く()
'**************************************************

    Dim ファイルを開くダイアログボックス
    Dim 検索結果
   Const Default = 1
   
   'Windows XP では、UserAccounts.CommonDialog オブジェクトを使用して
   '標準の [ファイルを開く] ダイアログ ボックスを表示することができます。
   'http://www.microsoft.com/japan/technet/scriptcenter/resources/qanda/jan05/hey0128.mspx
    Set ファイルを開くダイアログボックス = CreateObject("UserAccounts.CommonDialog")
    'HotVBS.AppActivate

    ファイルを開くダイアログボックス.Filter = 拡張子
    ファイルを開くダイアログボックス.InitialDir = フォルダパス
    検索結果 = ファイルを開くダイアログボックス.ShowOpen
     
    If 検索結果 = 0 Then
        HotVBS.Quit   '終了★
    Else
        入力ファイルフルパス = ファイルを開くダイアログボックス.FileName                      ?
    End If
    
    Set ファイルを開くダイアログボックス = Nothing
    
End Sub

'**********************************************************************
'★★★WinXP以外用の、ファイル名の一覧表示と、指定ファイル名の取得★★★
Sub ブラウザで指定フォルダのファイルを表示()
'**********************************************************************
    Dim ファイル, ファイルデータ, 出力文字列, ファイル名

    拡張子 = Mid(拡張子, InStr(拡張子, "."), 4)          ?

   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   Set ファイル = ファイルシステムオブジェクト.GetFolder(フォルダパス)
   出力文字列=""
   
   For Each ファイルデータ In ファイル.Files
      ? ファイルデータ.name
      If Right(ファイルデータ.name, 4) = 拡張子 Then
         出力文字列 = 出力文字列 & ファイルデータ.name & "<br>"     ?
      End If
   Next

   Call ブラウザで表示(出力文字列)

   ファイル名 = InputBox _
   ("対象ソースのキーワード・ファイルを、IEブラウザのリストから一つだけコピーして、" _
    & Chr(13) & "下のボックスに貼り付けて、「OK」を押して下さい。", _
   "変換ファイル名", , , 7000)
   
   If ファイル名 = "" Then 
      '画面をクリアします
      IEオブジェクト.Navigate "about:blank"
      'Aブラウザを終了します
      IEオブジェクト.Quit
      'オブジェクトの破棄
      Set IEオブジェクト = Nothing
      HotVBS.Quit
   End If
   
   入力ファイルフルパス = フォルダパス & ファイル名
   
   'B画面をクリアします
   IEオブジェクト.Navigate "about:blank"
   'Aブラウザを終了します
   IEオブジェクト.Quit
   'オブジェクトの破棄
   Set IEオブジェクト = Nothing
   
   Set ファイル = Nothing
   Set ファイルシステムオブジェクト = Nothing

End Sub

'************************************************
'ブラウザで、引数のテキストを、そのまま表示
Sub ブラウザで表示(出力文字列)
'************************************************

   'IEオブジェクトオブジェクトを作成します
   Set IEオブジェクト = CreateObject("InternetExplorer.Application")

   'ウィンドウの大きさを変更します
   IEオブジェクト.Width = 400
   IEオブジェクト.Height = 500

   '表示位置を変更します
   IEオブジェクト.Left = 100
   IEオブジェクト.Top = 10

   'インターネットエクスプローラ画面を表示します
   IEオブジェクト.Visible = True

   '@カラのページを表示します
   '(これを行わないと以降のdocument.writeなどがエラーになるため)
   IEオブジェクト.Navigate "about:blank"

   'AHTMLを出力します
   With IEオブジェクト.Document
      .Write "<html lang='ja'>" & VbCrLf
      .Write "<head>" & VbCrLf
      .Write "<meta http-equiv='content - type' content='text / html; charset = Shift_JIS'>" & VbCrLf
      .Write "<title>出力文字列をブラウザ表示</title>" & VbCrLf
      .Write "</head>" & VbCrLf
      .Write "<body>" & VbCrLf

      .Write "<br>" & VbCrLf
      .Write 出力文字列 & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "対象ファイルを、上から一つだけコピーして、インプット・ボックスに貼り付けて下さい。<br>" & VbCrLf

      .Write "<br>" & VbCrLf
      .Write "</body>" & VbCrLf
      .Write "</html>" & VbCrLf
   End With

   '0.5秒待ちます
   HotVBS.Sleep(500)

End Sub


 解説:
 FileSystemObject (FSO) オブジェクトのモデルには、次のオブジェクトとコレクションが含まれています。

 FileSystemObjectの使い方まとめ
https://d.hatena.ne.jp/nacookan/20080221/1203607060
 ↑使い方が、うまく整理されています。

オブジェクトまたはコレクション内容
FileSystemObject メイン オブジェクト。ドライブ、フォルダ、およびファイルに関して、作成、削除、情報の取得などの一般的な操作を行うためのメソッドとプロパティが格納されています。
 このオブジェクトに関連付けられたメソッドの多くは、他の FSO オブジェクトのメソッドを複製します。これらの複製されたメソッドは、便宜的に用意されています。
Drive オブジェクト。共有名や空き容量など、システムに接続されたドライブについての情報を収集するためのメソッドとプロパティが格納されています。
 "ドライブ" は、ハード・ディスクだけでなく、CD-ROM ドライブや RAM ディスクも対象になります。また、ドライブは、必ずしもシステムに物理的に接続されている必要はなく、ネットワークを介して論理的に接続されている場合も対象になります。
Drives コレクション。システムに物理的または論理的に接続されたドライブの一覧を提供します。
 Drives コレクションには、種類に関係なくあらゆるドライブが含まれます。リムーバブル メディアは、ドライブにメディアがセットされていなくても Drives コレクションに追加されます。
File オブジェクト。ファイルの作成、削除、または移動に使用するためのメソッドとプロパティが格納されています。
 ファイル名、パス、およびその他のプロパティをシステムから取得することもできます。
Files コレクション。フォルダに格納されたすべてのファイルの一覧を提供します。
Folder オブジェクト。フォルダの作成、削除、または移動に使用するためのメソッドとプロパティが格納されています。
 フォルダ名、パス、およびその他のプロパティをシステムから取得することもできます。
Folders コレクション。Folder オブジェクトに格納されたすべてのフォルダの一覧を提供します。
TextStream オブジェクト。テキスト ファイルを読み書きできます。


 OpenTextFile メソッドは、指定したファイルを開き、開いたファイルの読み取り、または追加書き込みに使用できる TextStream オブジェクトを返します。

 object.OpenTextFile(filename[, iomode[, create[, format]]])

object 必ず指定します。FileSystemObject オブジェクトの名前を指定します。

filename 必ず指定します。作成するファイルの名前を表す文字列式を指定します。

iomode 省略可能です。指定する値については、次の「設定値」を参照してください。

create 省略可能です。引数 filename で指定したファイルが存在しなかった場合に新しいファイルを作成するかどうかを示すブール値を指定します。新しいファイルを作成する場合は真 (true) を、ファイルを作成しない場合は偽 (false) を指定します。省略した場合、新しくファイルは作成されません。

format 省略可能です。開くファイルの形式を示す値を指定します。指定する値については、次の「設定値」を参照してください。省略した場合、ASCII ファイルとしてファイルが開かれます。

設定値
 引数 iomode の設定値は次のとおりです。
定数内容
ForReading1ファイルを読み取り専用として開きます。このファイルには書き込むことができません。
ForWriting2ファイルを書き込み専用として開きます。
ForAppending8ファイルを開き、ファイルの最後に追加して書き込みます。

 引数 format の設定値は次のとおりです。
内容
TristateTrueファイルを Unicode ファイルとして開きます。
TristateFalseファイルを ASCII ファイルとして開きます。
TristateUseDefaultシステム デフォルトを使ってファイルを開きます。


 ReadAll メソッドは、TextStream ファイル全体を読み込み、その結果の文字列を返します。

 Close メソッドは、開いた状態の TextStream ファイルを閉じます。

 GetFolder メソッドは、指定されたパスに置かれているフォルダに対応する Folder オブジェクトを返します。

 Files コレクションには、フォルダ内のすべての File オブジェクトが含まれています。


この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


フォルダ内の指定拡張子のファイル名一覧表示

 教えていただいたサイト:フォルダ内のファイル一覧を取得する
https://bayashita.com/p/entry/show/33

'	フォルダ内の指定拡張子のファイル名一覧表示
'	https://bayashita.com/p/entry/show/33

Option Explicit
'*****************************************************************
'■経歴
'	2021/03/09:作成
	
'■用途:
'	特定フォルダ内の対象拡張子のファイル一覧を表示します。
'	当該レベルのフォルダのみを対象として、下位フォルダは対象にしません。

'■使い方
'	スクリプトを起動すると、ファイルを開くダイアログが開きます。
'	対象にしたい拡張子のファイルを、何れか指定します。
'	同じフォルダに、ファイル一覧(Files.txt)を作成して保存します。(Files.txt が既存ならば上書きします)

'**********************************************************
Dim 検索結果
Dim 入力ファイルフルパス
Dim 開始日時
Dim 終了日時
Dim 現在のパス
Dim ファイルシステムオブジェクト
Dim フォルダオブジェクト
Dim ファイルオブジェクト
Dim 出力テキストストリームオブジェクト
Dim 拡張子

    FileDialog.Filter = "テキスト・ファイル(*.txt)|*.txt|全てのファイル(*.*)|*.*"
    
    'ファイルを開くダイアログを表示
    '閉じるとき、ファイルが選択されたらTrue、
    'キャンセルされたらFalseを返します
    検索結果 = FileDialog.ShowOpen
    If 検索結果 = False Then
        HotVBS.Quit
    Else
        入力ファイルフルパス = FileDialog.FileName                                          ?
    End If

    ' 開始時刻を変数に格納します。
    開始日時 = Now
    
    'ファイルシステムを扱うオブジェクトを作成
    Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

    現在のパス = Left(入力ファイルフルパス, InStrRev(入力ファイルフルパス, "\") )           ?
    'GetExtensionNameメソッド
    拡張子 = UCase(ファイルシステムオブジェクト.GetExtensionName(入力ファイルフルパス))

    'ファイル一覧出力用 TextStream オブジェクトを作成
    '第2引数は 1 :読み取り、2 :上書き、3 :追記。
    Set 出力テキストストリームオブジェクト = ファイルシステムオブジェクト.OpenTextFile("Files.txt", 2, True)
 
    'フォルダのオブジェクトを取得
    Set フォルダオブジェクト = ファイルシステムオブジェクト.GetFolder(現在のパス)
 
    'FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
    For Each ファイルオブジェクト In フォルダオブジェクト.Files
        'ファイル名を取得し、ログファイルに出力
        If UCase(ファイルシステムオブジェクト.GetExtensionName(ファイルオブジェクト.Path)) = 拡張子 Then
            出力テキストストリームオブジェクト.WriteLine ファイルオブジェクト.Name
        End If
    Next
 
    'TextStream は Close を忘れずに
    出力テキストストリームオブジェクト.Close

    Set 出力テキストストリームオブジェクト = Nothing
    Set フォルダオブジェクト  = Nothing
    Set ファイルシステムオブジェクト = Nothing 

    終了日時 = Now
    MsgBox "処理を終了しました。" & vbNewLine _
       & "処理時間は、" & FormatDateTime(終了日時 - 開始日時) & " でした。"



この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


選択文字列を Google/DeepL で和⇔英テキスト翻訳


■用途:
選択文字列を、和英判定して、和⇔英テキスト翻訳する。

■使い方
表示している画面で、翻訳したい文字列を選択して、ホットキー操作する。

■経歴
 2010/12/30:作成
 2011/01/02:和英判定して、翻訳まで自動化
 2011/01/04:対訳表示まで自動化
 2011/04/05:Excite対訳を止めて、livedoorを追加
 2011/04/24:Yahooを追加
 2011/05/03:英辞郎のルビを除外
 2011/09/01:Exciteの画面変更に対応。Yahoo用を止める(livedoorとほとんど同じため)
 2012/06/04:Exciteの画面変更に対応。
 2015/04/17:2015年1月29日11時で、「livedoor翻訳」サービスが終了したことを受けて修正。
 2015/07/14:Google翻訳を追加。Excite対訳を中断(テキスト入力できないので)
 2017/07/17:Bing 翻訳を追加。Yahoo!翻訳 サービス終了による
 2020/05/16:infoseek から DeepL 翻訳に変更

■参考にさせていただいたサイト
'ドキュメントオブジェクトモデル(DOM)
'http://www.tohoho-web.com/js/dom.htm
'VBAからIE操作 .document.forms(0).Submit でフォーム送信処理
'http://www.ken3.org/vba/backno/vba105.html

Option Explicit
   Dim IEオブジェクトGo       ' IE オブジェクトGoogle用
   Dim HTMLElementGo          ' HTMLDivElement
   Dim IEオブジェクトDeepL    ' IE オブジェクトDeepL用

'**********************************************************
Function 翻訳(文字列)
'**********************************************************
   Dim 表示するGoURL         ' 表示するページ
   Dim 表示するDeepLURL      ' 表示するページ  
   Dim 正規表現オブジェクト
   Dim 和英判定
   Dim n
   Dim 文字列LF

   Set 正規表現オブジェクト = New RegExp
   正規表現オブジェクト.Pattern = "[^\x01-\x7E]" '2バイト文字

   '文字列を、英文か和文か判定する
   和英判定 = "英文"
   表示するGoURL = "https://translate.google.com/#view=home&op=translate&sl=en&tl=ja" 'Google の英文テキスト翻訳画面
   表示するDeepLURL = "https://www.deepl.com/ja/translator#en/ja/"                    'DeepL の英文テキスト翻訳画面

   If 正規表現オブジェクト.Test(文字列) = True Then
      和英判定 = "和文"
      表示するGoURL = "https://translate.google.com/#view=home&op=translate&sl=ja&tl=en" 'Google の和文テキスト翻訳画面
      表示するDeepLURL = "https://www.deepl.com/ja/translator#ja/en/"                    'DeepL の和文テキスト翻訳画面
   End If
   'MsgBox 和英判定
  
   Set 正規表現オブジェクト = Nothing

   '************************************
   
   Set IEオブジェクトDeepL = WScript.CreateObject("InternetExplorer.Application")
   
   If Err.Number = 0 Then
   
      文字列LF = 正規表現で置換(文字列, "\r\n", "%0A") ? '改行CR + LFを16進LFに変更

      表示するDeepLURL = 表示するDeepLURL & 文字列LF 
      IEオブジェクトDeepL.Navigate 表示するDeepLURL
      IEオブジェクトDeepL.Visible = True

      HotVBS.Sleep(500)
      
      Call IE表示待ちDeepL

   Else
      WScript.Echo "エラー:" & Err.Description
   End If
   
   Set IEオブジェクトDeepL = Nothing
   
   '************************************

   Set IEオブジェクトGo = WScript.CreateObject("InternetExplorer.Application")

   If Err.Number = 0 Then
  
      IEオブジェクトGo.Navigate 表示するGoURL
      IEオブジェクトGo.Visible = True
        
      Call IE表示待ちGo
    
      '原文欄のテキストボックスに入力
      Set HTMLElementGo = IEオブジェクトGo.document.getElementsByClassName _
      ("orig tlid-source-text-input goog-textarea")(0)
   
      HTMLElementGo.Value = 文字列
   
      HotVBS.Sleep(300)

      Call IE表示待ちGo

   Else
      WScript.Echo "エラー:" & Err.Description
   End If
   
   '************************************
   
   Set HTMLElementGo = Nothing
   Set IEオブジェクトGo = Nothing
    
End Function

'**********************************************************
'メイン
'**********************************************************
Dim クリップボード文字列
ClipBoard.Clear				'クリップボードをクリア
HotVBS.Copy				'選択文字列をクリップボードにコピー
クリップボード文字列 = ClipBoard.Text                                      ? '関数に渡す文字列
クリップボード文字列 = 正規表現で置換(クリップボード文字列, "{.*?}", "") ? '英辞郎のルビ除去

If クリップボード文字列 <> "" Then
   翻訳(クリップボード文字列)		'翻訳サイトに渡す
End If
ClipBoard.Undo				'クリップボードを戻す

'**********************************************************
' IEがビジー状態の間待つ

Sub IE表示待ちGo()
   Do While IEオブジェクトGo.Busy = True Or IEオブジェクトGo.readystate <> 4
      WScript.Sleep 100
   Loop
   WScript.Sleep 1000
   WScript.Sleep 500
End Sub

Sub IE表示待ちDeepL()
   Do While IEオブジェクトDeepL.Busy = True Or IEオブジェクトDeepL.readystate <> 4
      WScript.Sleep 100
   Loop
   WScript.Sleep 1000
   WScript.Sleep 500
End Sub

 解説:
 ブラウザの表示が終わるまで、次の処理を待たせるところがポイントのようです。
 もしうまく動かない場合は、待ち時間を長くしてみて下さい。

 IE 画面を、スクリプトで操作する
 インターネット・エクスプローラの画面にデータを入力する方法について、私が体験したものを、備忘録としてまとめています。

 Internet Explorer オブジェクト モデルへのアクセス
http://msdn.microsoft.com/ja-jp/library/cc325990.aspx#odc_accessingie_manipactivepage
anchors:IHTMLElementCollection name または id 属性を持つすべての A エレメント。このコレクションのエレメントは、 HTML ソース内の順序で並びます。
links:IHTMLElementCollection href 属性を持つすべての A エレメント。

 Internet Explorerオブジェクト (InternetExplorer.Application)
http://www.roy.hi-ho.ne.jp/mutaguchi/wsh/object/ie.htm

 "各種スクリプト言語から"InternetExplorerを操作するメモ
http://www.geocities.co.jp/SiliconValley-Bay/3475/ie.html

 7.9 フォームの操作2
http://www.happy2-island.com/vbs/cafe02/capter00709.shtml

 JScript / VBScript (WSH)で,IEを自動操作しよう
http://d.hatena.ne.jp/language_and_engineering/20090713/p1

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


画像インライン表示

 処理のポイント:
1.文脈に沿って html タグを挿入して html文書に変換する。
2.テキストと画像とURLリンクを、IEブラウザに、表示する。


'   画像インライン表示

'   このスクリプトを実行したことによる結果について、責任は持てませんので悪しからず。

'   作成:2007/09/15
'   更新:2007/10/06  パスに、空白が含まれるときの対応として、"を追加。
'   更新:2007/10/13  URL画像直接リンクへの対応を追加。


'   現在のバージョンでは、一行に複数の画像が登録されている場合、
'   一行にURLと画像が混在する場合、には対応していません。

'■用途:
'   テキスト・ベースのアウトライン・プロセッサのリンク画像を、
'   テキストと一体でブラウザに表示します。

'   ☆ TextClipper    ☆
'   ☆ Nami2000       ☆
'   ☆ kie            ☆
'   ☆ VerticalEditor ☆
'   など、著名なアウトライン・プロセッサは、画像ファイルを、リンク形式で添付できます。
'   画像ファイルは、シェルリンクなので、クリックすれば、ビュアソフトで個別に表示できます。
'   しかし、やはり文章と一緒に画像を見れたほうが、良いですよね。
'   そのために、このツールを作りました。

'■使い方
'   プロセッサの、「表示させたいテキスト画面(ペイン)を、マウスク左クリックでアクティブにして」、
'   ホットキー操作すると、ブラウザ上に、文字と画像が一体表示されます。
'   (URLリンクも有効です。(^^)v)

'■カスタマイズ方法
'   ブラウザ表示の、背景色と文字色とURLリンク色は、下記の★の部分を変更すれば、自由に設定できます。

'   画像リンクが、絶対パスの場合は、特にパスの修正は、必要有りません。
'   画像リンクが、データ・ファイルの登録パスを使った、相対指定になっている場合は、
'   お使いのソフトのデータ・フォルダ・パスを★★の部分で、調整して下さい。

'■謝辞
'1.このスクリプトの、テキストをHTMLに変換して、IEで表示させる部分は、
'結城圭介さんの「VBScript&JScript Tips」を参考にさせていただきました。
'http://www.happy2-island.com/vbs/cafe02/capter00705.shtml

'2.こんなツールが、いとも簡単に作れてしまう「HotVBS」に感謝!
'(この謝辞は、1番に書くべきかもしれませんが。)


'****************☆☆☆☆☆☆☆☆**************************
Option Explicit
Dim i, j, 全体行数, 文字列, Body, htmlタイトル, 開始行, URL, REST
Dim TextClipperPath , NamiPath , kiePath, VerticalEditorPath
Dim Header01, Header02, Header11, Header12, Header13, Style
Dim IEオブジェクト
Dim 既存内容, 変換対象

Sub 画像インライン表示(文字列)

   '********************************************************
   '              ★文字色↓        ★背景色↓   ★URLリンク色   ★既視URL色    ★選択中URL色
   Style = "<body  text='white' bgcolor='#2f4f4f' link='aqua' vlink='lime' alink='fuchsia' STYLE =' line-height: 150%; margin-left: 3%; margin-right:  3%;'>"
   TextClipperPath = "D:\TextClipper\"             '★★TextClipperのデータのフォルダパスをここに記入★★
   NamiPath = "C:\tool\Nami2000\"                  '★★Nami2000のデータのフォルダパスをここに記入★★
   kiePath = "C:\tool\kie\"                        '★★kieのデータのフォルダパスをここに記入★★
   VerticalEditorPath = "C:\tool\VerticalEditor\"  '★★VerticalEditorのデータのフォルダパスをここに記入★★

   '**************************************************************
   'テキストファイルを、htmlに変換
   '1行ずつに分割
   ? 文字列
   文字列 = Split(文字列, VbCrLf)
   
   'トップ行を、htmlタイトルと見なす
   htmlタイトル = 文字列(0)                                         ?
   
   '全体行数を取得
   全体行数 = UBound(文字列)                                        ?
   
   '最終行の処理
   文字列(全体行数) = RTrim(文字列(全体行数))                       ?
   While 文字列(全体行数) = "" 
      '空白行は除く
      全体行数 = 全体行数 - 1
      文字列(全体行数) = RTrim(文字列(全体行数))
   Wend 
   
   '一行目は、そのまま見出しとして使う
   Body = "<br>" & VbCrLf & "<h1>" & 文字列(0) & "</h1>" & VbCrLf
   i = 0
   If InStr(文字列(i), ".jpg>") Or InStr(文字列(i), ".bmp>") Or InStr(文字列(i), ".png>") _
      Or InStr(文字列(i), ".gif>") Or InStr(文字列(i), "http://") Or InStr(文字列(i), "https://") _
      Or InStr(文字列(i), ".swf>") Or InStr(文字列(i), ".wav>") Or InStr(文字列(i), ".asf>") _
      Or InStr(文字列(i), ".wma>") Or InStr(文字列(i), ".wmv>") Or InStr(文字列(i), ".asx>") _
      Or InStr(文字列(i), ".wax>") Or InStr(文字列(i), ".wvx>") Or InStr(文字列(i), ".mp3>") _
      Or InStr(文字列(i), ".flv>") Then
      開始行 = 0
   Else
      開始行 = 1
   End If
   
   '1行目にリンク対象がある場合はそれから、
   'そうでないときは、2行目から順に、空白でない最後の行まで、一行ずつタグを挿入していく
   
   For i = 開始行 To 全体行数
      文字列(i) = RTrim(文字列(i))
      '************************************************************
      '画像の摘出を優先的に行う。
      '画像の拡張子とリンクタグで、当該部分を検出しています。
      
      If InStr(文字列(i), ".jpg>") Or InStr(文字列(i), ".bmp>") Or InStr(文字列(i), ".png>") _
         Or InStr(文字列(i), ".gif>") Then
         文字列(i) = Trim(文字列(i))                                ?
         文字列(i) = Replace(文字列(i), ">", Chr(34) & ">")         ?           'ファイル名の後ろに、「"」Chr(34)を追加
         
         If  Left(文字列(i), 6) = "<file=" Then                'TextClipper
            If Mid(文字列(i), 8, 1) = ":" Then
               文字列(i) = "<img src=" & Chr(34) & Right(文字列(i), Len(文字列(i)) - 6)                    ?
            Else
               文字列(i) = "<img src=" & Chr(34) & TextClipperPath & Right(文字列(i), Len(文字列(i)) - 6)  ?
            End If
            ? 文字列(i)
         ElseIf Left(文字列(i), 6) = "<file@" Then              'Nami2000 Or kie
            If Mid(文字列(i), 8, 1) = ":" Then
               文字列(i) = "<img src=" & Chr(34) & Right(文字列(i), Len(文字列(i)) - 6)
            Else
               文字列(i) = "<img src=" & Chr(34) & NamiPath & Right(文字列(i), Len(文字列(i)) - 6)          ?
            End If
         ElseIf  Left(文字列(i), 7) = "<shell:" Then            'VerticalEditor
            If Mid(文字列(i), 9, 1) = ":" Then
               文字列(i) = "<img src=" & Chr(34) & Right(文字列(i), Len(文字列(i)) - 7)
            Else
               文字列(i) = "<img src=" & Chr(34) & VerticalEditorPath & Right(文字列(i), Len(文字列(i)) - 7) ?
            End If
         End If
         
      '************************************************************
      ' つづいて、URL直接リンク画像も摘出する。
      'http の開始と、画像の拡張子までの範囲として、URLを検出します。
      ElseIf  (InStr(文字列(i), "http://") Or InStr(文字列(i), "https://")) _
      And (Right(文字列(i), 4) = ".jpg"  Or Right(文字列(i), 4) = ".bmp" _
      Or Right(文字列(i), 4) = ".png" Or Right(文字列(i), 4) = ".gif") _
      Then
      
         文字列(i) = "<img src=" & Chr(34) & 文字列(i) & Chr(34) & ">"
      
      '************************************************************
      ' つづいて、URL単純リンクも摘出する。
      'http の開始と、空白、日本語、かっこまでの範囲として、URLを検出します。
      ElseIf  InStr(文字列(i), "http://") Or InStr(文字列(i), "https://")  Then
         '未処理分の文字列を格納する変数として、REST を定義
         REST = Trim(文字列(i))
         'いったん、行の変数は、空白にする
         文字列(i) = ""
         '一行の中に、URLが複数あるときも考慮して、繰り返す
         While  InStr(REST, "http://") Or InStr(REST, "https://")  
            '未処理分の文字列から、httpを探して、それより左側を、行変数に追加する
            文字列(i) = 文字列(i) & Left(REST, InStr(REST, "http") - 1) ?
            'httpから右側を、未処理の変数に格納
            REST = Right(REST, Len(REST) - InStr(REST, "http") + 1)          ?
            '未処理分の文字列を一文字ずつ確認して、全角や空白がくるまでの文字数を取得
            For j = 1 To Len(REST)
               '                                           "は16進ASCII文字コードで表現
               If 正規表現で文字列チェック(" | |[ぁ-ヶ]|[亜-K]|\(|\)|)|'|\x22", Mid(REST, j, 1)) _
                  Then  '検索パターン文字列チェック
                  Exit For
               End If
            Next
            'http から、空白、日本語、かっこまでの範囲を、URLとして書き出す
            URL = Trim(Left(REST, j - 1))   ?
            'URL以降の文字列を、未処理分の文字列として、格納し直す
            REST = Right(REST, Len(REST) - Len(URL))                   ?
            '行変数の方には、URL部分に、リンクタグを付けて、追加する
            文字列(i) = 文字列(i) &  "<a href='" & URL & "' target='_blank'>" & URL & "</a>"
         Wend
         'URLとして摘出されなかった右側残りの文字列を、行変数に加える
         文字列(i) = 文字列(i) & REST
         
      '************************************************************
      'ショック・ウエーブなど、その他のファイルも、がんばってみる。
      ElseIf InStr(文字列(i), ".swf>") Or InStr(文字列(i), ".wav>") Or InStr(文字列(i), ".asf>") _
         Or InStr(文字列(i), ".wma>") Or InStr(文字列(i), ".wmv>") Or InStr(文字列(i), ".asx>") _
         Or InStr(文字列(i), ".wax>") Or InStr(文字列(i), ".wvx>") Or InStr(文字列(i), ".mp3>") _
         Or InStr(文字列(i), ".flv>") Then
         文字列(i) = Trim(文字列(i))
         文字列(i) = Replace(文字列(i), ">", Chr(34) & ">")         ?           'ファイル名の後ろに、「"」Chr(34)を追加

         If  Left(文字列(i), 6) = "<file=" Then                'TextClipper
            If Mid(文字列(i), 8, 1) = ":" Then
               文字列(i) = "<embed src=" & Chr(34) & Right(文字列(i), Len(文字列(i)) - 6)
            Else
               文字列(i) = "<embed src=" & Chr(34) & TextClipperPath & Right(文字列(i), Len(文字列(i)) - 6)  ?
            End If
         ElseIf Left(文字列(i), 6) = "<file@" Then              'Nami2000 Or kie
            If Mid(文字列(i), 8, 1) = ":" Then
               文字列(i) = "<embed src=" & Chr(34) & Right(文字列(i), Len(文字列(i)) - 6)
            Else
               文字列(i) = "<embed src=" & Chr(34) & NamiPath & Right(文字列(i), Len(文字列(i)) - 6)  ?
            End If
         ElseIf  Left(文字列(i), 7) = "<shell:" Then            'VerticalEditor
            If Mid(文字列(i), 9, 1) = ":" Then
               文字列(i) = "<embed src=" & Chr(34) & Right(文字列(i), Len(文字列(i)) - 7)
            Else
               文字列(i) = "<embed src=" & Chr(34) & VerticalEditorPath & Right(文字列(i), Len(文字列(i)) - 7)  ?
            End If
         End If
      End If 
      
      ? 文字列(i)
      Body = Body & 文字列(i) & "<br>" & VbCrLf ?
   Next
   
   
   '***************************************************************
   ' 以下で、IEブラウザに表示します。
   'IEオブジェクトオブジェクトを作成します
   Set IEオブジェクト = CreateObject("InternetExplorer.Application")
   
   'インターネットエクスプローラ画面を表示します
   IEオブジェクト.Visible = True
   
   '@カラのページを表示します
   '(これを行わないと以降のdocument.writeなどがエラーになるため)
   IEオブジェクト.Navigate "about:blank"
   
   Header01 = "<!DOCTYPE HTML PUBLIC ' - / / W3C / / DTD HTML 4.01 Transitional / / EN'>"
   Header02 = "<html lang='ja'><head><meta http-equiv='content - type' content='text / html; charset = Shift_JIS'><title>"
   Header11 = "</title></head>"
   
   'AHTMLを出力します
   IEオブジェクト.Document.Write Header01 & VbCrLf
   IEオブジェクト.Document.Write Header02 & VbCrLf
   IEオブジェクト.Document.Write htmlタイトル & VbCrLf
   IEオブジェクト.Document.Write Header11 & VbCrLf
   IEオブジェクト.Document.Write Style & VbCrLf
   IEオブジェクト.Document.Write Body & VbCrLf
   IEオブジェクト.Document.Write "<br></body></html>" & VbCrLf
   
   'オブジェクトの破棄
   Set IEオブジェクト = Nothing

End Sub

'**************************************************
'  ★★★正規表現で文字列チェック★★★

Function 正規表現で文字列チェック(正規表現パターン, 検索対象文字列)
   '正規表現パターン:正規表現
   '検索対象文字列:検索対象
'**************************************************

   Dim 正規表現オブジェクト
   Set 正規表現オブジェクト = New RegExp          ' 正規表現オブジェクトを作ります。
   正規表現オブジェクト.Pattern = 正規表現パターン       ?   ' パターンを設定します。
   正規表現で文字列チェック = 正規表現オブジェクト.Test(検索対象文字列)      ' 検索をテストします。
      '正規表現で文字列チェック = True          '一致する文字列が 1 つ以上見つかりました。
      '正規表現で文字列チェック = False         '一致する文字列が見つかりません。
   Set 正規表現オブジェクト = Nothing            'オブジェクトの開放
End Function 

'****************☆☆☆☆☆☆☆☆**************************
'選択範囲を変換
既存内容 = HotVBS.ClipBoard   'バックアップ用
HotVBS.ClipBoard = ""            'クリップボードをクリア

HotVBS.Copy                     'エディタからクリップボードへコピー
変換対象 = HotVBS.ClipBoard      '変換対象
If 変換対象 = "" Then
   HotVBS.SelAll
   HotVBS.Copy
   変換対象 = HotVBS.ClipBoard      '変換対象
   HotVBS.Reset
End If

If 変換対象 <> "" Then
   Call 画像インライン表示(変換対象)
End If
HotVBS.ClipBoard = 既存内容	'クリップボードを戻す



この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


テキスト・ファイを比較して、差分を別ファイルに出力

ファイルABからそれぞれの差分を出力 ■経歴
 2011/03/05:作成
 2011/03/12:別フォルダの同一ファイル名でも比較可能に
 2013/04/27:一致行が無いときにループする不具合を修正

■用途:
 Windows のテキスト形式の、二つのファイルを、行単位に比較して、それぞれの差異の部分を、ファイル出力する。
 右の図で、元のファイル「A」「B」を比較して、差分を、「diff_A」「diff_B」というファイル名で、抽出します。

■特長
 二つのファイル名を指定するだけで、それぞれのファイルをソートして、差分を抽出します。

■使い方
 ホットキー操作(デフォルトは、[CTRL]+[Enter])すると、ファイルを開くダイアログが表示されます。
 比較したい2つのファイルを選択します。
 選択したファイルと同じフォルダに、「diff_対象ファイル名」のファイル名で、差分ファイルが作成されます。
 行数が、2百万行以上のファイルを比較したい場合は、入力ファイル配列の部分の要素数を増やして下さい。

■注意
 結果のファイル名と、同じファイルが存在した場合は、上書きします。
 同じ行が片方は1行、もう片方は2行あると、1行は差分として出力されます。


Option Explicit

Dim ファイルシステムオブジェクト 'As Object          ' FileSystemObject
Dim 入力ファイルフルパス群
Dim 入力ファイルフルパス配列
Dim 入力ファイル名1 'As String
Dim 入力ファイル名2 'As String
Dim 入力ファイル行数1
Dim 入力ファイル行数2
Dim 拡張子
Dim フォルダ
Dim 出力ファイル名1 'As String
Dim 出力ファイル名2 'As String
Dim 入力ファイル配列1(2000000)
Dim 入力ファイル配列2(2000000)
Dim 開始時刻 'As Variant
Dim 終了時刻 'As Variant

'***********************************************
'二つのファイルの差異部分を、それぞれ出力()

Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

'比較対象のファイル名を取得

'ファイルダイアログの複数ファイル選択対応
FileDialog.AllowMultiSelect = True
'タイトルバーに表示するテキスト
FileDialog.Title = "比較対象のファイルを、選択して下さい。"
'開くときの、デフォルト・ディレクトリ
'   FileDialog.InitialDir = HotVBS.ExePath
'デフォルトのファイル拡張子
'(拡張子が入力されなかったときに自動的に付加される拡張子)
FileDialog.DefaultExt = "txt"
'ファイルマスク(フィルタ)
FileDialog.Filter = "テキストファイル(*.txt)|*.txt|その他 (log, ini, csv, tsv, *htm*)|*.log;*.ini;*.csv;*.tsv;*.*htm*|全てのファイル(*.*)|*.*"
'開いたときに選択されているデフォルトのフィルタNo(最初のフィルタNo=1)
FileDialog.FilterIndex = 1

'[開く]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。
If FileDialog.ShowOpen Then
   入力ファイルフルパス群 = FileDialog.FileName ?
   'FileDialogはファイル名を取得するだけで、ファイル操作は行いません。
   '実際のファイル操作は、スクリプトで実現します。

   'ファイル名を分割
   入力ファイルフルパス配列 = Split(入力ファイルフルパス群, VbCrLf)
   拡張子 = ファイルシステムオブジェクト.GetExtensionName(入力ファイルフルパス配列(0)) ?
   フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイルフルパス配列(0))
   開始時刻 = Now()

   If UBound(入力ファイルフルパス配列) = 1  Then
      入力ファイル名1 = 入力ファイルフルパス配列(0)  ?
      入力ファイル名2 = 入力ファイルフルパス配列(1)  ?
      フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイルフルパス配列(0))
      出力ファイル名1 = フォルダ & "\diff_" _
      & ファイルシステムオブジェクト.GetFileName(入力ファイルフルパス配列(0))
      出力ファイル名2 = フォルダ & "\diff_" _
      & ファイルシステムオブジェクト.GetFileName(入力ファイルフルパス配列(1))

      Call 入力ファイルを読み込む(入力ファイル名1, 入力ファイル配列1, 入力ファイル行数1)
      Call 入力ファイルを読み込む(入力ファイル名2, 入力ファイル配列2, 入力ファイル行数2)

      Call 数値Sort(入力ファイル配列1, 0, 入力ファイル行数1)
      Call 数値Sort(入力ファイル配列2, 0, 入力ファイル行数2)
      
      Call 差異行を出力(入力ファイル配列1, 入力ファイル行数1, 入力ファイル配列2, 入力ファイル行数2, 出力ファイル名1)
      Call 差異行を出力(入力ファイル配列2, 入力ファイル行数2, 入力ファイル配列1, 入力ファイル行数1, 出力ファイル名2)
      
   Else 
      MsgBox "選択したファイル数が一つか、三つ以上です。" & vbNewLine  _
      & "選択ファイルは二つにして下さい。" & vbNewLine  _
      & "終了します。"
      Set ファイルシステムオブジェクト = Nothing
      HotVBS.Quit
   End If
Else
   MsgBox "選択したファイルが有りません。" & vbNewLine _
   & "終了します。"
   Set ファイルシステムオブジェクト = Nothing
   HotVBS.Quit
End If    

終了時刻 = Now
MsgBox "差分出力を終わりました。" & vbNewLine _
& "処理時間は、" _
& FormatDateTime(終了時刻 - 開始時刻) & " でした。"

Set ファイルシステムオブジェクト = Nothing
'**************************************************************

'************************************************
Sub 入力ファイルを読み込む(入力ファイル名, 入力ファイル配列(), 入力ファイル行数)
'************************************************

   Dim 処理行カウンタ
   Dim 入力テキストストリームオブジェクト 'As Object    ' TextStream
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
    
   ' 指定ファイルをOPEN(入力モード)
   Set 入力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.OpenTextFile(入力ファイル名, 1)
    
   処理行カウンタ = 0
   '*************データの読み込み***********
   Do Until 入力テキストストリームオブジェクト.AtEndOfStream
      ' レコードの読み込み
      入力ファイル配列(処理行カウンタ) = 入力テキストストリームオブジェクト.ReadLine

      処理行カウンタ = 処理行カウンタ + 1
   Loop ' 最終行まで繰り返す
   入力ファイル行数 = 処理行カウンタ - 1
End Sub


'************************************************
Sub 差異行を出力(入力配列1, 入力行数1, 入力配列2, 入力行数2, 出力ファイル名)
'************************************************

   Dim 検索行
   Dim 処理行
   Dim 検索開始行
   Dim 出力件数
   Dim 出力テキストストリームオブジェクト 'As Object    ' TextStream

   ' 指定ファイルをOPEN(出力モード)
   Set 出力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.CreateTextFile(出力ファイル名)

   検索開始行 = 0
   出力件数 = 0

   For 処理行 = 0 To 入力行数1

      For 検索行 = 検索開始行 To 入力行数2 '検索はキーが一致したところから始める
         If 入力配列1(処理行) = 入力配列2(検索行) Then
            検索開始行 = 検索行 + 1
            Exit For
         ElseIf 入力配列1(処理行) < 入力配列2(検索行) Then
            出力テキストストリームオブジェクト.WriteLine 入力配列1(処理行) ' 改行(CrLf)付き
            出力件数 = 出力件数 + 1
            検索開始行 = 検索行 'ソートされているので、行き過ぎた時点で照合をパス
            Exit For
         Else '入力配列2(検索行)の方が小さい
            '入力配列2(検索行)を、次の行に進める
            検索開始行 = 検索行
         End If
         
      Next '検索行

      If 検索開始行 >= 入力行数2 Then
         If 入力配列1(処理行) > 入力配列2(入力行数2) Then
            出力テキストストリームオブジェクト.WriteLine 入力配列1(処理行) ' 改行(CrLf)付き
            出力件数 = 出力件数 + 1
         End If
      End If
      
   Next '処理行
   
   MsgBox 出力ファイル名 & " として、" & 出力件数 & " 行を出力しました。"
   ' 指定ファイルをClose(出力モード)
   出力テキストストリームオブジェクト.Close
   Set 出力テキストストリームオブジェクト = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


テキスト比較(ソート済を前提)

 上で紹介した、「テキスト・ファイを比較して、差分を別ファイルに出力」は、VBScript でソートするため、2百万行までのファイルしか、取り扱うことができません。
 このため、前もってソートしておいたファイルを前提に、比較だけするスクリプトも作りました。


'■経歴
' 2012/01/27:作成:ソート済を前提に、行数の制限を無くす

'■用途:
' Windows のテキスト形式の、二つのファイルを、行単位に比較して、それぞれの差異の部分を、ファイル出力する。

'■特長
' 二つのファイル名を指定するだけで、それぞれのファイルの差分を抽出します。

'■使い方
' ホットキー操作(デフォルトは、[CTRL]+[Enter])すると、ファイルを開くダイアログが表示されます。
' 比較したい2つのファイルを選択します。
' 選択したファイルと同じフォルダに、「Sdiff_対象ファイル名」のファイル名で、差分ファイルが作成されます。

'■注意
' 結果のファイル名と、同じファイルが存在した場合は、上書きします。


Option Explicit

Dim ファイルシステムオブジェクト 'As Object          ' FileSystemObject
Dim 入力ファイルフルパス群
Dim 入力ファイルフルパス配列
Dim 入力ファイル名1 'As String
Dim 入力ファイル名2 'As String
Dim 入力ファイル行数1
Dim 入力ファイル行数2
Dim 拡張子
Dim フォルダ
Dim 出力ファイル名1 'As String
Dim 出力ファイル名2 'As String
Dim 開始時刻 'As Variant
Dim 終了時刻 'As Variant
Dim YesNo

'***********************************************
'二つのファイルの差異部分を、それぞれ出力()

Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

'比較対象のファイル名を取得

'ファイルダイアログの複数ファイル選択対応
FileDialog.AllowMultiSelect = True
'タイトルバーに表示するテキスト
FileDialog.Title = "比較対象のファイルを、選択して下さい。"
'開くときの、デフォルト・ディレクトリ
'	FileDialog.InitialDir = HotVBS.ExePath
'デフォルトのファイル拡張子
'(拡張子が入力されなかったときに自動的に付加される拡張子)
FileDialog.DefaultExt = "txt"
'ファイルマスク(フィルタ)
FileDialog.Filter = "テキストファイル(*.txt)|*.txt|その他 (log, ini, csv, tsv, *htm*)|*.log;*.ini;*.csv;*.tsv;*.*htm*|全てのファイル(*.*)|*.*"
'開いたときに選択されているデフォルトのフィルタNo(最初のフィルタNo=1)
FileDialog.FilterIndex = 1

'[開く]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。
If FileDialog.ShowOpen Then
	入力ファイルフルパス群 = FileDialog.FileName ?
	'FileDialogはファイル名を取得するだけで、ファイル操作は行いません。
	'実際のファイル操作は、スクリプトで実現します。

	'ファイル名を分割
	入力ファイルフルパス配列 = Split(入力ファイルフルパス群, VbCrLf)
	拡張子 = ファイルシステムオブジェクト.GetExtensionName(入力ファイルフルパス配列(0)) ?
	フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイルフルパス配列(0))
	開始時刻 = Now()

	If UBound(入力ファイルフルパス配列) = 1  Then
		入力ファイル名1 = 入力ファイルフルパス配列(0)  ?
		入力ファイル名2 = 入力ファイルフルパス配列(1)  ?
		フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイルフルパス配列(0))
		出力ファイル名1 = フォルダ & "\Sdiff_" _
		& ファイルシステムオブジェクト.GetFileName(入力ファイルフルパス配列(0)) ?
		出力ファイル名2 = フォルダ & "\Sdiff_" _
		& ファイルシステムオブジェクト.GetFileName(入力ファイルフルパス配列(1)) ?


		Call 入力ファイルを読んで差異行を出力


	ElseIf UBound(入力ファイルフルパス配列) = 0  Then
	
		YesNo = MsgBox ("選択したファイル数が一つです。もう一つファイルを選択しますか?" & vbNewLine _
		& "(はい:もう一つファイルを選択、いいえ:終了します)", 36, "ファイル選択の確認")
		YesNo ?
		If YesNo = vbYes Then '6
			入力ファイル名1 = 入力ファイルフルパス配列(0)  ?
			フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイルフルパス配列(0))
			出力ファイル名1 = フォルダ & "\Sdiff_" _
			& ファイルシステムオブジェクト.GetFileName(入力ファイルフルパス配列(0)) ?

			'ファイルダイアログの複数ファイル選択対応
			FileDialog.AllowMultiSelect = False
			'タイトルバーに表示するテキスト

			'[開く]ボタンの付いた、ファイルダイアログを表示します。
			'設定されるとTrue、キャンセルされるとFalseを返します。
			If FileDialog.ShowOpen Then
				入力ファイル名2 = FileDialog.FileName ?
				'FileDialogはファイル名を取得するだけで、ファイル操作は行いません。
				'実際のファイル操作は、スクリプトで実現します。
				フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイル名2)
				出力ファイル名2 = フォルダ & "\Sdiff_" _
				& ファイルシステムオブジェクト.GetFileName(入力ファイル名2) ?
				
				If 入力ファイル名2 = 入力ファイル名1 Then
					MsgBox "選択したファイルが、重複しています。" & vbNewLine  _
					& "ファイルは、異なる二つのファイルを選択下さい。" & vbNewLine  _
					& "一旦終了します。"
					Set ファイルシステムオブジェクト = Nothing
					HotVBS.Quit
				End If


				Call 入力ファイルを読んで差異行を出力


			Else
				MsgBox "選択したファイル数が、一つです。" & vbNewLine  _
				& "選択ファイルは二つにして下さい。" & vbNewLine  _
				& "終了します。"
				Set ファイルシステムオブジェクト = Nothing
				HotVBS.Quit
			End If
			
		ElseIf  YesNo = vbNo Then '7
			Set ファイルシステムオブジェクト = Nothing
			HotVBS.Quit
		Else 
			Set ファイルシステムオブジェクト = Nothing
			HotVBS.Quit
		End If

	Else 
		MsgBox "選択したファイル数が、三つ以上です。" & vbNewLine  _
		& "選択ファイルは二つにして下さい。" & vbNewLine  _
		& "終了します。"
		Set ファイルシステムオブジェクト = Nothing
		HotVBS.Quit
	End If

Else 
	MsgBox "選択したファイルが有りません。" & vbNewLine  _
	& "終了します。"
	Set ファイルシステムオブジェクト = Nothing
	HotVBS.Quit
End If    

終了時刻 = Now
MsgBox "差分出力を終わりました。" & vbNewLine _
& "処理時間は、" _
& FormatDateTime(終了時刻 - 開始時刻) & " でした。"
? FormatDateTime(終了時刻 - 開始時刻)

Set ファイルシステムオブジェクト = Nothing
HotVBS.Quit
'**************************************************************




'************************************************
Private Sub 入力ファイルを読んで差異行を出力()
'************************************************

	Dim 出力件数1
	Dim 出力件数2
	Dim 出力テキストストリームオブジェクト1 'As Object    ' TextStream
	Dim 出力テキストストリームオブジェクト2 'As Object    ' TextStream

	Dim 処理行カウンタ1
	Dim 処理行カウンタ2
	Dim 入力テキストストリームオブジェクト1 'As Object    ' TextStream
	Dim 入力テキストストリームオブジェクト2 'As Object    ' TextStream
	Dim 入力行データ1
	Dim 入力行データ2
	Dim 入力行データ1直前
	Dim 入力行データ2直前
	Dim 入力1状況
	Dim 入力2状況

	Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
    
	' 指定ファイルをOPEN(入力モード)
	Set 入力テキストストリームオブジェクト1 = _
	ファイルシステムオブジェクト.OpenTextFile(入力ファイル名1, 1)
	Set 入力テキストストリームオブジェクト2 = _
	ファイルシステムオブジェクト.OpenTextFile(入力ファイル名2, 1)
    
	処理行カウンタ1 = 0
	処理行カウンタ2 = 0

	' 指定ファイルをOPEN(出力モード)
	Set 出力テキストストリームオブジェクト1 = _
	ファイルシステムオブジェクト.CreateTextFile(出力ファイル名1)
	Set 出力テキストストリームオブジェクト2 = _
	ファイルシステムオブジェクト.CreateTextFile(出力ファイル名2)

	出力件数1 = 0
	出力件数2 = 0
	入力行データ1 = ""
	入力行データ2 = ""
	
	
	Do 
		If 入力行データ1 = 入力行データ2 Then
		
			If 入力テキストストリームオブジェクト1.AtEndOfStream _
				And 入力テキストストリームオブジェクト2.AtEndOfStream Then
					入力1状況 = "入力1終了"
					入力2状況 = "入力2終了"
					Exit Do
			ElseIf 入力テキストストリームオブジェクト2.AtEndOfStream Then
				入力2状況 = "入力2終了"
				入力行データ1直前 = 入力行データ1
				入力行データ1 = 入力テキストストリームオブジェクト1.ReadLine
				処理行カウンタ1 = 処理行カウンタ1 + 1
				
				If 処理行カウンタ1 > 2 And 入力行データ1直前 > 入力行データ1 Then Exit Do
				
			ElseIf 入力テキストストリームオブジェクト1.AtEndOfStream Then
				入力1状況 = "入力1終了"
				入力行データ2直前 = 入力行データ2
				入力行データ2 = 入力テキストストリームオブジェクト2.ReadLine
				処理行カウンタ2 = 処理行カウンタ2 + 1
				
				If 処理行カウンタ2 > 2 And 入力行データ2直前 > 入力行データ2 Then Exit Do
				
			Else
				入力行データ1直前 = 入力行データ1
				入力行データ1 = 入力テキストストリームオブジェクト1.ReadLine
				処理行カウンタ1 = 処理行カウンタ1 + 1
				
'				If 正規表現オブジェクト.Test(入力行データ1) = True _
'				And 入力テキストストリームオブジェクト1.AtEndOfStream = False Then
'					出力テキストストリームオブジェクト1.WriteLine 入力行データ1 ' 改行(CrLf)付き
'					出力件数1 = 出力件数1 + 1
'					入力行データ1 = 入力テキストストリームオブジェクト1.ReadLine
'					処理行カウンタ1 = 処理行カウンタ1 + 1
'				End If

				If 処理行カウンタ1 > 2 And 入力行データ1直前 > 入力行データ1 Then Exit Do
				
				
				入力行データ2直前 = 入力行データ2
				入力行データ2 = 入力テキストストリームオブジェクト2.ReadLine
				処理行カウンタ2 = 処理行カウンタ2 + 1
				
				If 処理行カウンタ2 > 2 And 入力行データ2直前 > 入力行データ2 Then Exit Do
				
			End If

		ElseIf 入力行データ1 < 入力行データ2 Then
'				MsgBox "入力配列1(処理行) < 入力配列2(検索行)" & vbNewLine _
'				& "処理行:" & 処理行 & " 検索行:" & 検索行 & vbNewLine _
'				& "処理行:" & 入力配列1(処理行) & vbNewLine _
'				& "検索行:" & 入力配列2(検索行)

			If  入力テキストストリームオブジェクト1.AtEndOfStream Then
				入力1状況 = "入力1終了"
				If  入力テキストストリームオブジェクト2.AtEndOfStream Then
					入力2状況 = "入力2終了"
					Exit Do
				Else
					出力テキストストリームオブジェクト2.WriteLine 入力行データ2 ' 改行(CrLf)付き
					出力件数2 = 出力件数2 + 1
					入力行データ2直前 = 入力行データ2
					入力行データ2 = 入力テキストストリームオブジェクト2.ReadLine
					処理行カウンタ2 = 処理行カウンタ2 + 1
					
					If 処理行カウンタ2 > 2 And 入力行データ2直前 > 入力行データ2 Then Exit Do

				End If
			Else
				出力テキストストリームオブジェクト1.WriteLine 入力行データ1 ' 改行(CrLf)付き
				出力件数1 = 出力件数1 + 1
				入力行データ1直前 = 入力行データ1
				入力行データ1 = 入力テキストストリームオブジェクト1.ReadLine
				処理行カウンタ1 = 処理行カウンタ1 + 1
				
				If 処理行カウンタ1 > 2 And 入力行データ1直前 > 入力行データ1 Then Exit Do

			End If

		ElseIf 入力行データ1 > 入力行データ2 Then
'				MsgBox "入力配列1(処理行) > 入力配列2(入力行数2)" & vbNewLine _
'				& "処理行:" & 処理行 & " 検索行:" & 検索行 & vbNewLine _
'				& "処理行:" & 入力配列1(処理行) & vbNewLine _
'				& "検索行:" & 入力配列2(検索行)
			
			If  入力テキストストリームオブジェクト2.AtEndOfStream Then
				入力2状況 = "入力2終了"
				If  入力テキストストリームオブジェクト1.AtEndOfStream Then
					入力1状況 = "入力1終了"
					Exit Do
				Else
					出力テキストストリームオブジェクト1.WriteLine 入力行データ1 ' 改行(CrLf)付き
					出力件数1 = 出力件数1 + 1
					入力行データ1直前 = 入力行データ1
					入力行データ1 = 入力テキストストリームオブジェクト1.ReadLine
					処理行カウンタ1 = 処理行カウンタ1 + 1
					
					If 処理行カウンタ1 > 2 And 入力行データ1直前 > 入力行データ1 Then Exit Do

				End If
			Else
				出力テキストストリームオブジェクト2.WriteLine 入力行データ2 ' 改行(CrLf)付き
				出力件数2 = 出力件数2 + 1
				入力行データ2直前 = 入力行データ2
				入力行データ2 = 入力テキストストリームオブジェクト2.ReadLine
				処理行カウンタ2 = 処理行カウンタ2 + 1
				
				If 処理行カウンタ2 > 2 And 入力行データ2直前 > 入力行データ2 Then Exit Do

			End If
		End If
		
	Loop '入力行を次々続ける
   
   If 入力行データ1直前 > 入力行データ1 Or 入力行データ2直前 > 入力行データ2 Then 
		MsgBox 処理行カウンタ1 & " か、" & 処理行カウンタ2  & " で、ソートエラーで終了しました。"  & vbNewLine _
		& "入力1状況=" & 入力1状況  & " 入力2状況=" & 入力2状況
		出力テキストストリームオブジェクト1.WriteLine 入力行データ1 ' 改行(CrLf)付き
		出力件数1 = 出力件数1 + 1
		出力テキストストリームオブジェクト2.WriteLine 入力行データ2 ' 改行(CrLf)付き
		出力件数2 = 出力件数2 + 1
		
   End If
   
	MsgBox 出力ファイル名1 & " として、" & 出力件数1 & " 行を出力しました。" & vbNewLine _
		& 出力ファイル名2 & " として、" & 出力件数2 & " 行を出力しました。" 
	' 指定ファイルをClose(出力モード)
	出力テキストストリームオブジェクト1.Close
	出力テキストストリームオブジェクト2.Close
	Set 出力テキストストリームオブジェクト1 = Nothing
	Set 出力テキストストリームオブジェクト2 = Nothing
	
		' 指定ファイルをClose(入力モード)
	入力テキストストリームオブジェクト1.Close
	入力テキストストリームオブジェクト2.Close
	Set 入力テキストストリームオブジェクト1 = Nothing
	Set 入力テキストストリームオブジェクト2 = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


テキストファイルの先頭切り出し

■作成:2011/12/26
■内容:テキスト・ファイルの先頭を、指定行だけ切り出して、別ファイル名で保存する
■目的:巨大なテキスト・ファイルの内容を確認しやすくする


Option Explicit

   'ファイルを開くときの、初期ディレクトリ
Const パス = "D:\"
Dim 入力ファイルフルパス 'As String
   Dim 開始日時 'as Long
   Dim 終了日時 'as Long
   Dim YesNo
   Dim 出力行数 '切り出し出力する行数

'************************************************
'★★★ファイル名の取得★★★
'************************************************

   Dim 検索結果
   FileDialog.InitialDir = パス
   'ファイルマスク(フィルタ)
   FileDialog.Filter = "テキスト・ファイル(*.txt,*.csv)|*.txt;*.csv"
   
   'ファイルを開くダイアログを表示
   '閉じるとき、ファイルが選択されたらTrue、
   'キャンセルされたらFalseを返します
   検索結果 = FileDialog.ShowOpen
   If 検索結果 = False Then
      HotVBS.Quit
   Else
      入力ファイルフルパス = FileDialog.FileName ?
   End If

   出力行数 = CInt(InputBox("先頭から切り出す行数を入力して下さい。") )

   開始日時 = Now
      
   Call テキスト切り出し

   終了日時 = Now
   MsgBox "出力しました。" & vbNewLine _
   & "処理時間は、" _
   & FormatDateTime(終了日時 - 開始日時) & " でした。"
   HotVBS.Quit

Sub テキスト切り出し

   Dim 入力行数
   Dim ファイルシステムオブジェクト
   Dim 出力ファイルフルパス
   Dim テキストファイル
   Dim 出力ファイル
   Dim 入力文字列
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   Set テキストファイル = ファイルシステムオブジェクト.OpenTextFile(入力ファイルフルパス) ' テキストファイルのオープン

   出力ファイルフルパス = Left(入力ファイルフルパス, InStrRev(入力ファイルフルパス, ".") - 1) _
   & "先頭から" & CStr(出力行数) & "行" _
   & Right(入力ファイルフルパス, Len(入力ファイルフルパス) - InStrRev(入力ファイルフルパス, ".") + 1) ?

   Set 出力ファイル = ファイルシステムオブジェクト.CreateTextFile(出力ファイルフルパス)
   
     ' テキストファイルの内容読み込み処理
   入力行数 = 0
   Do Until 入力行数 >= 出力行数
      入力文字列 = テキストファイル.ReadLine             ' 1行読み込み
      入力行数 = 入力行数 + 1
      出力ファイル.WriteLine 入力文字列
   Loop
      
   テキストファイル.Close
   出力ファイル.Close
   Set 出力ファイル = Nothing
   Set テキストファイル = Nothing
   Set ファイルシステムオブジェクト = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


テキストファイルの頭と尻を切り出し

' 更新:2013/02/06:尻のファイルに、全体行数を追加 内容:テキスト・ファイルの先頭と最後を、指定行だけ切り出して、別ファイル名で保存する
目的:巨大なテキスト・ファイルの内容を確認しやすくする


Option Explicit

   'ファイルを開くときの、初期ディレクトリ
   Const パス = "D:\"
   Dim 入力ファイルフルパス 'As String
   Dim 開始日時 'as Long
   Dim 終了日時 'as Long
   Dim YesNo
   Dim 出力行数 '切り出し出力する行数
   Dim ファイル行数 '対象ファイルの全行数
   Dim 尻配列()
   Dim 尻カウンタ

'************************************************
'★★★テキストファイルの頭と尻を切り出し★★★
'************************************************

   Dim 検索結果
   FileDialog.InitialDir = パス
   'ファイルマスク(フィルタ)
   FileDialog.Filter = "テキスト・ファイル(*.txt,*.csv)|*.txt;*.csv|全てのファイル(*.*)|*.*"
   
   'ファイルを開くダイアログを表示
   '閉じるとき、ファイルが選択されたらTrue、
   'キャンセルされたらFalseを返します
   検索結果 = FileDialog.ShowOpen
   If 検索結果 = False Then
      HotVBS.Quit
   Else
      入力ファイルフルパス = FileDialog.FileName ?
   End If

   出力行数 = CInt(InputBox("頭・尻から切り出す行数を入力して下さい。") )

   開始日時 = Now
   ReDim 尻配列(出力行数)
     
   Call テキスト切り出し
   
   If ファイル行数 > 出力行数 Then
      Call テキスト尻切り出し
   End If

   終了日時 = Now
   If ファイル行数 > 出力行数 Then
      MsgBox "出力しました。" & vbNewLine _
      & "処理時間は、" _
      & FormatDateTime(終了日時 - 開始日時) & " でした。" & vbNewLine _
      & "ファイル行数= " & FormatNumber(ファイル行数, 0, 0, 0, - 1)
   Else
      MsgBox "指定行数よりファイル行数が少ないか等しいので、先頭のみ出力しました。" & vbNewLine _
      & "処理時間は、" _
      & FormatDateTime(終了日時 - 開始日時) & " でした。" & vbNewLine _
      & "ファイル行数= " & FormatNumber(ファイル行数, 0, 0, 0, - 1)
   End If
   
   HotVBS.Quit

'************************************************
Sub テキスト切り出し

   Dim 入力行数
   Dim ファイルシステムオブジェクト
   Dim 出力ファイルフルパス
   Dim テキストファイル
   Dim 出力ファイル
   Dim 入力文字列
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   Set テキストファイル = ファイルシステムオブジェクト.OpenTextFile(入力ファイルフルパス) ' テキストファイルのオープン

   出力ファイルフルパス = Left(入力ファイルフルパス, InStrRev(入力ファイルフルパス, ".") - 1) _
   & "頭から" & CStr(出力行数) & "行" _
   & Right(入力ファイルフルパス, Len(入力ファイルフルパス) - InStrRev(入力ファイルフルパス, ".") + 1) ?

   Set 出力ファイル = ファイルシステムオブジェクト.CreateTextFile(出力ファイルフルパス)
   
     ' テキストファイルの内容読み込み処理
   入力行数 = 0
   尻カウンタ = 0
   
   Do Until テキストファイル.AtEndOfStream
      入力文字列 = テキストファイル.ReadLine             ' 1行読み込み
      入力行数 = 入力行数 + 1
      
      If 入力行数 <= 出力行数 Then
         出力ファイル.WriteLine 入力文字列
      End If
      
      尻カウンタ = 尻カウンタ + 1
      If 尻カウンタ > 出力行数 Then
         尻カウンタ = 1
      End If
     
      尻配列(尻カウンタ) = 入力文字列
     
   Loop
   
   出力ファイル.Close
   ファイル行数 = 入力行数
   
   テキストファイル.Close
   Set 出力ファイル = Nothing
   Set テキストファイル = Nothing
   Set ファイルシステムオブジェクト = Nothing

End Sub

'************************************************
Sub テキスト尻切り出し

   Dim ファイルシステムオブジェクト
   Dim 出力ファイルフルパス
   Dim 出力ファイル
   Dim 出力行
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   出力ファイルフルパス = Left(入力ファイルフルパス, InStrRev(入力ファイルフルパス, ".") - 1) _
   & "尻から" & CStr(出力行数) & "行" _
   & Right(入力ファイルフルパス, Len(入力ファイルフルパス) - InStrRev(入力ファイルフルパス, ".") + 1) ?

   Set 出力ファイル = ファイルシステムオブジェクト.CreateTextFile(出力ファイルフルパス)
   
     ' 尻配列の内容を書き出し
   For 出力行 = 尻カウンタ + 1 To 出力行数 '前半:配列の途中が切れ目になっているため
      出力ファイル.WriteLine 尻配列(出力行)
   Next
   
   For 出力行 = 1 To 尻カウンタ             '後半:配列の途中が切れ目になっているため
      出力ファイル.WriteLine 尻配列(出力行)
   Next
   
   出力ファイル.WriteLine vbNewLine
   出力ファイル.WriteLine "ファイル行数= " & FormatNumber(ファイル行数, 0, 0, 0, - 1)

   出力ファイル.Close
   
   Set 出力ファイル = Nothing
   Set ファイルシステムオブジェクト = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


複数テキストをバイナリ結合


■経歴
 2011/02/05:作成

■用途:
 Windows のテキスト形式の複数ファイルを、一つのファイルに結合します。

■特長
 ファイルを、バイナリで読み書きするため、Shift-JIS以外でも、全ての文字コードのファイルを取り扱うことができます。
 例えば、中国語(GB2312)のファイルも、文字化けすることなく、結合できます。
 注意:結合対象のファイルは、当然、同じ文字コードでないと、結合したファイルを、正しく読めません。

■使い方
 結合対象のファイルは、同一フォルダにあることを、前提としています。
 ホットキー操作(デフォルトは、[CTRL]+[Enter])すると、ファイルを開くダイアログが表示されます。
 結合対象のファイルを選択します。
 選択したファイルと同じフォルダに、「結合ファイル」というファイル名で結合ファイルが作成されます。
 注意:結合結果のファイル名と、同じ名前のファイルが存在した場合は、上書きします。

■謝辞
 このスクリプトは、下記で公開いただいているコードを、ほぼそのまま使わせて頂きました。

 1.VBScriptでバイナリファイルを読み書きする (ここにはいないボクへの伝言)
http://tambourine.cocolog-nifty.com/dengon/2006/12/vbscript_1d8d.html

 2.JavaScript の文字コード処理に関する覚書 (Kanegon's Web Page)
http://www2.wbs.ne.jp/~kanegon/doc/code.txt

 その他、下記のサイトの情報も、参考にさせていただきました。

 ADO レコードセット、レコード、およびストリーム オブジェクトを使用してドキュメントを開く方法
http://support.microsoft.com/kb/248255/ja
 Stream オブジェクト
http://msdn.microsoft.com/ja-jp/library/cc364272.aspx
 ADODB.Stream を使ったファイルの読み書き
http://homepage3.nifty.com/aokura/jscript/adodb.html

■追記:
ファイルを複数選択したとき、変数に格納されるファイルの並び順は、OS のバージョンによって、下記のようになります。
このスクリプトでは、Win XP や Win 2000 で使われることを考慮して、ファイルの結合順をソートする機能を付けています。

1.Win 7
選択されたファイル群は、ファイルを開くダイアログの詳細で、ソート表示されている順に、格納されます。

2.Win XP
選択されたファイル群は、ファイルを開くダイアログの詳細で、ソート表示されている順に、格納されます。
ただし、「最後に選択したもの」だけは、リストのトップに来ます。

3.Win2000
選択されたファイル群は、ファイルを開くダイアログの詳細で、ソート表示されている順に、格納されます。
ただし、
「最初に選択したもの」は、一番最後に、
「最後に選択したもの」は、トップに来ます。


Option Explicit
   Dim ファイルシステムオブジェクト
   Dim 入力ファイルフルパス群
   Dim 入力ファイルフルパス配列
   Dim 入力ファイルフルパス
   Dim 拡張子
   Dim ファイル追番
   Dim ADODB入力ストリーム 'As ADODB.Stream
   Dim ADODB出力ストリーム
   Dim 一時ストリーム
   Dim ファイル内容 
   Dim 合体内容 
   Dim フォルダ
   Dim バイナリCrLf
   Dim カウンタ
   Dim 最終行

Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

'ファイルダイアログの複数ファイル選択対応
FileDialog.AllowMultiSelect = True
'タイトルバーに表示するテキスト
   FileDialog.Title = "結合対象のファイルを、選択して下さい。"
'開くときの、デフォルト・ディレクトリ
   FileDialog.InitialDir = HotVBS.ExePath
'ファイルマスク(フィルタ)
   FileDialog.Filter = "テキストファイル(*.txt)|*.txt|その他 (log, ini, csv, tsv, *htm*)|*.log;*.ini;*.csv;*.tsv;*.*htm*|全てのファイル(*.*)|*.*"
'開いたときに選択されているデフォルトのフィルタNo(最初のフィルタNo=1)
   FileDialog.FilterIndex = 2


'改行コードを作成
Set 一時ストリーム = CreateObject("ADODB.Stream")
With 一時ストリーム
   .Type = 2 'テキストモード
   .Charset = "shift_jis"
   .Open
   .WriteText VbCrLf
   .Position = 0
   .Type = 1
End With

バイナリCrLf = 一時ストリーム.Read(2)

Set 一時ストリーム = Nothing


合体内容 = Null
カウンタ = 0

'[開く]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。
If FileDialog.ShowOpen Then
   入力ファイルフルパス群 = FileDialog.FileName ?
   'FileDialogはファイル名を取得するだけで、ファイル操作は行いません。
   '実際のファイル操作は、スクリプトで実現します。
   
   'ファイル名を分割
   入力ファイルフルパス配列 = Split(入力ファイルフルパス群, VbCrLf)
   拡張子 = ファイルシステムオブジェクト.GetExtensionName(入力ファイルフルパス配列(0)) ?
   フォルダ = ファイルシステムオブジェクト.GetParentFolderName(入力ファイルフルパス配列(0))

   'ファイルを結合
   ? UBound(入力ファイルフルパス配列)
   For ファイル追番 = 0 To UBound(入力ファイルフルパス配列)
      入力ファイルフルパス = 入力ファイルフルパス配列(ファイル追番) ?
'      MsgBox(入力ファイルフルパス)

      If ファイルシステムオブジェクト.FileExists(入力ファイルフルパス)  Then
         Set ADODB入力ストリーム = CreateObject("ADODB.Stream")
         
         With ADODB入力ストリーム
            .Type = 1 ' バイナリーモード
            .open
            .LoadFromFile(入力ファイルフルパス)
         End With
         ファイル内容 =  ADODB入力ストリーム.Read
         
         Do Until ADODB入力ストリーム.EOS
            ' レコードの読み込み
            最終行 = CStr(ADODB入力ストリーム.ReadText(adReadLine))
            ' 最終行まで繰り返す
         Loop
'         MsgBox 最終行

         If IsNull(ファイル内容) = False Then
            カウンタ = カウンタ + 1
            If IsNull(合体内容) = False Then
               If 最終行 = "" Then
                  合体内容 = 結合バイナリ(合体内容 , ファイル内容)
               Else ' [EOF]の行に文字が存在
                  合体内容 = 改行結合バイナリ(合体内容 , ファイル内容)               
               End If
            Else
               合体内容 = ファイル内容
            End If
         End If
         Set ADODB入力ストリーム = Nothing
      End If
   Next
   
   Set ADODB出力ストリーム = CreateObject("ADODB.Stream")
   
   If IsNull(合体内容) = False Then
      With ADODB出力ストリーム
         .Type = 1 ' バイナリーモード
         .open
         .Write 合体内容   
         .SaveToFile フォルダ & "\結合ファイル." & 拡張子, 2 '上書きモード
         .close
      End With
   End If

   Set ADODB出力ストリーム = Nothing
End If

MsgBox カウンタ & " 個のファイル (ファイル・サイズ 0 は対象外) を結合して、" & vbNewLine _
& フォルダ & "\結合ファイル." & 拡張子 & vbNewLine _
& "というファイル名で、書き出しました。"

' 2つのバイナリデータを結合して、新しいバイナリデータを返す(間に改行を入れる)
Function 改行結合バイナリ(バイナリ1, バイナリ2)
   Dim ADODBストリーム
   Set ADODBストリーム = CreateObject("ADODB.Stream")
   With ADODBストリーム
      .Type =  1 ' バイナリーモード
      .Open()
      .Write(バイナリ1)
      .Write(バイナリCrLf)
      .Write(バイナリ2)
      .Position = 0
   End With
   改行結合バイナリ = ADODBストリーム.Read()
   Set ADODBストリーム = Nothing
End Function

' 2つのバイナリデータを結合して、新しいバイナリデータを返す(間に改行を入れない)
Function 結合バイナリ(バイナリ1, バイナリ2)
   Dim ADODBストリーム
   Set ADODBストリーム = CreateObject("ADODB.Stream")
   With ADODBストリーム
      .Type =  1 ' バイナリーモード
      .Open()
      .Write(バイナリ1)
      .Write(バイナリ2)
      .Position = 0
   End With
   結合バイナリ = ADODBストリーム.Read()
   Set ADODBストリーム = Nothing
End Function

 解説:
定数 説明
adReadAll -1 既定値です。現在の位置から EOS マーカー方向に、すべてのバイトをストリームから読み取ります。
これは、バイナリ ストリームに唯一有効な StreamReadEnum 値です (TypeadTypeBinary)。
adReadLine -2 ストリームから次の行を読み取ります (LineSeparator プロパティで指定)。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る



青空文庫ルビタグ変換(漢字変数使用)

 処理のポイント:
1.テキスト・ファイルを、ReadLinewriteLine を使って、一行ずつ読み書きする。
2.書き出したファイルを、IEブラウザで表示する。

変換テスト用の変換前サンプル(riryou.html):「李陵(中島敦)(riryou.zip 43KB)」
変換結果は、こんな風に読みやすくなります→riryou_Ruby.html

 同じ内容を、Excel VBA で書いたものも有ります。


'   青空文庫ルビタグ変換(漢字変数使用)

'■用途:
'   青空文庫のルビ表現を、htmlのルビタグに変換

'■使い方:
'   ・事前準備
'   (0).HotVBSの「設定」→「スクリプト」→「ループ回数制限」を、1000000程度にして下さい。

'   (1).変換に使う文書ファイルを準備します。
'         文書ファイルか、テキスト形式の場合は、html形式に変換するソフトを準備します。
'         ソフトとしては、例えば Vertical Editor が有ります。

'   (2).Cドライブに、tempフォルダを作って下さい。
'   (既に有るならそれを使って下さい。TEMPは大文字でもかまいません。)
'   c:\temp\
'   
'   (3).作ったtempフォルダに、Vertical Editor などで、「html出力」して下さい。
'   
'   (4).貴方のOSが、WinXPの場合は、
'   「ファイルを開く」ダイアログ ボックスが、表示されるので、
'   変換対象のファイルを指定して下さい。ファイルを選択すると、即変換します。
'   変換後のファイル名は、変換前ファイル名の後ろに、_Rubyを追加したものになります。
'   
'    貴方のパソコンのOSが、WinXPでない場合は、以下の@〜Bの操作をして下さい。
'   
'   @.ブラウザに、ファイル一覧が表示されます。
'   そのリストから、タグ変換するファイル名を、選択して下さい。
'   A.変換処理するファイルを、一つだけブラウザでコピーして、
'   インプット・ボックスの枠に貼り付けて下さい。
'   B.インプット・ボックスの「OK」を押します。

'   Windows 95=Windows 4.0
'   Windows 2000   =NT 5.0
'   Windows XP     =NT 5.1
'   Windows Vista  =NT 6.0

'   
'■謝辞
'1.このスクリプトの、IEでメッセージを表示させる部分は、
'結城圭介さんの「VBScript&JScript Tips」を参考にさせていただきました。
'http://www.happy2-island.com/vbs/cafe02/capter00705.shtml

'■変更経歴:
'   ' 2006/06/04 VBA版作成
'   ' 2006/06/11 VBA からABに移植
'   ' 2006/07/17 VBA,AB から VBScript(hta) に移植
'   ' 2007/09/30 VBScript(hta) から、HotVBS に移植


Option Explicit

Const パス = "C:\temp\"
Public OS
Public 入力ファイル名 'As String
Public ファイル名
Dim IEオブジェクト

'**********************************************************************
'★★★WinXP以外用の、ファイル名の一覧表示と、指定ファイル名の取得★★★
Sub fileShowGo()
'**********************************************************************
    Dim fso, f, fileData, 出力文字列, searchFile1, searchFile2
   Dim newWindow
   Dim filesWindow

    
    searchFile1 = ".html"
    searchFile2 = ".htm"

   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(パス)

   For Each fileData In f.Files
      If Right(fileData.name, 5) = searchFile1 _
         Or Right(fileData.name, 4) = searchFile2 Then
            出力文字列 = 出力文字列 & fileData.name & "<br>"      ?
      End If
   Next

   Call IEで表示(出力文字列)
   
   ファイル名 = InputBox _
   ("変換処理するファイルを、ブラウザのリストから一つだけコピーして、下のボックスに貼り付けて、「OK」を押して下さい。", _
   "変換ファイル名", , , 8000)
   
   If ファイル名 = "" Then 
      '画面をクリアします
      IEオブジェクト.Navigate "about:blank"
      'Aブラウザを終了します
      IEオブジェクト.Quit
      'オブジェクトの破棄
      Set IEオブジェクト = Nothing
      HotVBS.Quit
   End If
   
   入力ファイル名 = パス & ファイル名
   
   'B画面をクリアします
   IEオブジェクト.Navigate "about:blank"
   'Aブラウザを終了します
   IEオブジェクト.Quit
   'オブジェクトの破棄
   Set IEオブジェクト = Nothing
   
   Call ルビタグ変換

End Sub

'************************************************
'★★★WinXP用の、ファイル名の取得★★★
Sub fileShowXP()
'************************************************

    Dim オブジェクトDialog
    Dim 検索結果

    Set オブジェクトDialog = CreateObject("UserAccounts.CommonDialog")

    オブジェクトDialog.Filter = "HTML Files|*.htm*"
    オブジェクトDialog.InitialDir = "C:\temp\"
    検索結果 = オブジェクトDialog.ShowOpen
     
    If 検索結果 = 0 Then
        HotVBS.Quit
    Else
        入力ファイル名 = オブジェクトDialog.FileName
        ファイル名 = Right(入力ファイル名, Len(入力ファイル名) - 8)
    End If
    OSバージョン = "XP"
    Call ルビタグ変換
    
End Sub

'================================================
'★★★ルビ・タグの変換処理★★★
'================================================
Public 入力行 'As String
Public 入力行文字数 'As Integer
Public 検索文字目 'As Integer 検索している文字の桁目
Public 出力行 'As String
Public 地文字数 'As Integer (ルビに無関係な部分の文字数)
Public 漢字字数 'As Integer (ルビを振られる部分の文字数)
Public ルビ字数 'As Integer
Public 漢字文字フラグ 'As Integer (ルビを振られる部分)
Public ルビ文字フラグ 'As Integer (ルビの部分)
Public 地文字フラグ 'As Integer (ルビに無関係な部分)
Public 出力ファイル名 'As String


Sub ルビタグ変換()

Dim bodyフラグ 'As Integer
Dim 処理行カウンタ 'As Integer
Dim 開始時刻 'as Long
Dim 終了時刻 'as Long

'	変換対象のファイル名とパス取得
	Dim ファイル・システム・オブジェクト, 入力ファイル, 出力ファイル

	出力ファイル名 = パス _
	& Left(ファイル名, InStr(ファイル名, ".") - 1) & "_Ruby.html"
	
		? 出力ファイル名

	開始時刻 = CLng(Left(Time, InStr(Time, ":") - 1)) * 3600 _
	+ CLng(Mid(Time, InStr(Time, ":") + 1, 2)) * 60 + CLng(Right(Time, 2))

    '********************************
    'ファイルのオープン。
    bodyフラグ = 0
    処理行カウンタ = 0
    
	Set ファイル・システム・オブジェクト = CreateObject("Scripting.FileSystemObject")
	Set 入力ファイル = ファイル・システム・オブジェクト.openTextFile(入力ファイル名, 1)
	Set 出力ファイル = ファイル・システム・オブジェクト.openTextFile(出力ファイル名, 8, True)
    '*************データの読み込み***********
	Do While 入力ファイル.atEndOfStream = False

        処理行カウンタ = 処理行カウンタ + 1
		入力行 = 入力ファイル.readLine
        出力行 = 入力行
        
        If 入力行 = "</body>" Then
            bodyフラグ = 0
        End If
        
        If bodyフラグ = 1 Then
            Call 本文処理  '★★★★★★★★★
        End If
          
        If Left(入力行, 5) = "<body" Then
            bodyフラグ = 1
        End If
        
		出力ファイル.writeLine(出力行)

        If 処理行カウンタ < 1000 And (処理行カウンタ Mod 100) = 0 _
 	       Or (処理行カウンタ Mod 1000) = 0 Then
'			MsgBox ProcessingLineCounter &  " 行目を読込み"
        End If
           
	Loop

    '**************終了処理*********************
	MsgBox 処理行カウンタ & " 最終行まで読込み完了"
	入力ファイル.Close()
	出力ファイル.Close()

    終了時刻 = CLng(Left(Time, InStr(Time, ":") - 1)) * 3600 _
    + CLng(Mid(Time, InStr(Time, ":") + 1, 2)) * 60 + CLng(Right(Time, 2))
    
    MsgBox( "処理が終了しました。" & Chr(13) & _
    "処理時間は、" & (終了時刻 - 開始時刻) & " 秒でした。")

End Sub


'★★★★★本文処理:文字操作★★★★★
Sub 本文処理()
    出力行 = ""
    地文字数 = 0
    漢字字数 = 0
    ルビ字数 = 0
    漢字文字フラグ = 0
    ルビ文字フラグ = 0
    
    入力行文字数 = Len(入力行)
    
    For 検索文字目 = 入力行文字数 To 1 Step - 1
    
        If Mid(入力行, 検索文字目, 1) = ">" Then
            地文字フラグ = 1
        End If
    
        If ルビ文字フラグ = 1 Then
            ルビ字数 = ルビ字数 + 1
        ElseIf 漢字文字フラグ = 1 Then
            漢字字数 = 漢字字数 + 1
        ElseIf 地文字フラグ = 1 Then
            地文字数 = 地文字数 + 1
        End If
        
        '漢字文字フラグの部分から、"》"が出現したときは、
        'ルビ文字フラグを立てるとともに、「ルビタグ後ろ+ルビタグ前」を挿入する。
        If 漢字文字フラグ = 1 And Mid(入力行, 検索文字目, 1) = "》" Then
            出力行 = "</rt><rp>)</rp></ruby><ruby><rb>" _
            & Mid(入力行, 検索文字目 + 1, 漢字字数 - 1) & 出力行
            
            漢字字数 = 0
            漢字文字フラグ = 0
            
            地文字数 = 0
            ルビ字数 = 0     '前回のルビ字数をリセット
            地文字フラグ = 0
            ルビ文字フラグ = 1
        
        '上の条件以外で、"》"が出現したときは、
        'ルビ文字フラグを立てるとともに、「ルビタグ後ろ」だけを挿入する。
        ElseIf Mid(入力行, 検索文字目, 1) = "》" Then
            出力行 = "</rt><rp>)</rp></ruby>" _
            & Mid(入力行, 検索文字目 + 1, 地文字数 - 1) & 出力行
            地文字数 = 0
            ルビ字数 = 0     '前回のルビ字数をリセット
            地文字フラグ = 0
            ルビ文字フラグ = 1
            
        '"《""が出現したときは、
        '漢字文字フラグを立てるとともに、「ルビタグ前」を挿入する。
        ElseIf Mid(入力行, 検索文字目, 1) = "《" Then
            出力行 = "</rb><rp>(</rp><rt>" _
            & Mid(入力行, 検索文字目 + 1, ルビ字数 - 1) & 出力行
            漢字字数 = 0     '前回の漢字字数をリセット
            ルビ文字フラグ = 0
            漢字文字フラグ = 1
            
        '漢字文字フラグの部分から、"|"(ルビ開始)が出現したときは、
        '地文字フラグを立てるとともに、「ルビタグ前」を挿入する。
        ElseIf 漢字文字フラグ = 1 And (Mid(入力行, 検索文字目, 1) = "|" _
        Or Mid(入力行, 検索文字目, 1) = "│") Then
              '"|"JIS 8162は記号の縦線。"│"JIS 84A0は罫線の縦線
            出力行 = "<ruby><rb>" & Mid(入力行, 検索文字目 + 1, 漢字字数 - 1) & 出力行
            漢字字数 = 0
            漢字文字フラグ = 0
            地文字フラグ = 1
            
        '漢字文字フラグの部分から、"("か")"が出現したときは、
        '地文字フラグを立てるとともに、「ルビタグ前」を挿入する。
        ElseIf 漢字文字フラグ = 1 And (Mid(入力行, 検索文字目, 1) = "(" _
        Or Mid(入力行, 検索文字目, 1) = ")") Then  '(例)1円山応挙《まるやまおうきょ》
            出力行 = "<ruby><rb>" & Mid(入力行, 検索文字目 + 1, 漢字字数 - 1) & 出力行
            漢字字数 = 0
            漢字文字フラグ = 0
            地文字フラグ = 1
            地文字数 = 1    '地のところまで侵食したため戻す
            
'        ElseIf Mid(入力行, 検索文字目 + 1, 1) >= "亜" And 漢字字数 > 1 _
'        And Mid(入力行, 検索文字目, 1) < "亜" Then  '★つぐみ対応★★★★6月5日追加
        
        '漢字部分の文字数が1以上で、"ヶ"より文字コードが大きいの文字から、
        '"ヶ"より文字コードの小さい文字に変わったところで、「ルビタグ前」を挿入。
        '"ヶ(8396カナの最大)""亜(889F漢字の最小)""](816E)"
        ElseIf Mid(入力行, 検索文字目 + 1, 1) > "ヶ" And 漢字字数 > 1 _
        And Mid(入力行, 検索文字目, 1) <= "ヶ" Then  '★大丈夫対応★★★★6月5日追加
            出力行 = "<ruby><rb>" & Mid(入力行, 検索文字目 + 1, 漢字字数 - 1) & 出力行
            漢字字数 = 0
            漢字文字フラグ = 0
            地文字フラグ = 1
            地文字数 = 1    '地のところまで侵食したため戻す
            
        '漢字の文字数が、ルビの文字数と同じになったところで、「ルビタグ前」を挿入
        ElseIf ルビ字数 > 0 And 漢字字数 = ルビ字数 Then
            出力行 = "<ruby><rb>" & Mid(入力行, 検索文字目 + 1, 漢字字数 - 1) & 出力行
            漢字字数 = 0
            漢字文字フラグ = 0
            地文字フラグ = 1
            地文字数 = 1    '地のところまで侵食したため戻す

        '行頭が漢字で終わる場合は、「ルビタグ前」を挿入
        ElseIf 漢字文字フラグ = 1 And 検索文字目 = 1 Then    '行頭のKanji
            出力行 = "<ruby><rb>" & Mid(入力行, 検索文字目, 漢字字数) & 出力行
            漢字字数 = 0
            漢字文字フラグ = 0

        End If
    
    Next '検索文字目
    
    If 地文字フラグ = 1 And 地文字数 > 0 Then
        出力行 = Mid(入力行, 検索文字目 + 1, 地文字数) & 出力行
    End If

End Sub



'*************************************
'メイン:OSを判定して処理を分岐
'*************************************

'対象ファイルを指定する方法が、OSによって違うため、Wordを使ってOSのバージョンを取得

Dim Wordオブジェクト

Set Wordオブジェクト = CreateObject ("Word.application").system
HotVBS.Sleep(500)
MsgBox Wordオブジェクト.OperatingSystem & " " _
& Wordオブジェクト.Version, vbInformation, "あなたのお使いのWindows のバージョン"

OS = Wordオブジェクト.Version
Wordオブジェクト.application.Quit
Set Wordオブジェクト = Nothing


Select Case OS
	Case 5.1 'Windows XP=NT 5.1
		OS = "XP"
		Call fileShowXP
	Case Else  '
		OS = ""
		Call fileShowGo
End Select

'処理結果を表示
'IEオブジェクトを作成します
Set IEオブジェクト = CreateObject("InternetExplorer.Application")

'ウィンドウの大きさを変更します
'objIE.Width = 800
'objIE.Height = 600

'表示位置を変更します
IEオブジェクト.Left = 0
IEオブジェクト.Top = 0

'インターネットエクスプローラ画面を表示します
IEオブジェクト.Visible = True

'@指定したURLを表示します
	?      出力ファイル名
IEオブジェクト.Navigate 出力ファイル名

'Aページの読み込みが終わるまでココでグルグル回る
Do Until IEオブジェクト.Busy = False
   '空ループだと無駄にCPUを使うので250ミリ秒のインターバルを置く
   HotVBS.Sleep(250)
Loop

Set IEオブジェクト = Nothing

'************************************************
'ブラウザで、引数のテキストを、そのまま表示
Sub IEで表示(出力文字列)
'************************************************

   'IEオブジェクトオブジェクトを作成します
   Set IEオブジェクト = CreateObject("InternetExplorer.Application")

   'ウィンドウの大きさを変更します
   IEオブジェクト.Width = 700
   IEオブジェクト.Height = 600

   '表示位置を変更します
   IEオブジェクト.Left = 100
   IEオブジェクト.Top = 10

   'インターネットエクスプローラ画面を表示します
   IEオブジェクト.Visible = True

   '@カラのページを表示します
   '(これを行わないと以降のdocument.writeなどがエラーになるため)
   IEオブジェクト.Navigate "about:blank"

   'AHTMLを出力します
   With IEオブジェクト.Document
      .Write "<html lang='ja'>" & VbCrLf
      .Write "<head>" & VbCrLf
      .Write "<meta http-equiv='content - type' content='text / html; charset = Shift_JIS'>" & VbCrLf
      .Write "<title>青空文庫→htmlRubyTag</title>" & VbCrLf
      .Write "</head>" & VbCrLf
      .Write "<body>" & VbCrLf

      .Write "<div align='Right'>作成:渡辺真 2006/07/17</div>" & VbCrLf
      .Write "<div align='Right'>HotVBS に移植 2007/09/30</div>" & VbCrLf
      .Write "<br>" & VbCrLf

      .Write "(1).Cドライブに、tempフォルダを作って下さい。<br>" & VbCrLf
      .Write "(既に有るならそれを使って下さい。TEMPは大文字でもかまいません。)<br>" & VbCrLf
      .Write "c:\temp\<br>" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "(2).作ったtempフォルダに、Vertical Editor などで、「html出力」して下さい。<br>" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write " 貴方のパソコンのOSが、WinXPでない場合は、以下の@〜Bの操作をして下さい。<br>" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "@.下に、対象フォルダのファイル一覧が表示されます。タグ変換するファイル名を、確認して下さい。" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "<br>" & VbCrLf
      .Write myData & VbCrLf
      .Write "<br>" & VbCrLf
      .Write "A.変換処理するファイルを、上から一つだけコピーして、インプット・ボックスに貼り付けて下さい。<br>" & VbCrLf

      .Write "<br>" & VbCrLf
      .Write "</body>" & VbCrLf
      .Write "</html>" & VbCrLf
   End With

   '0.5秒待ちます
   HotVBS.Sleep(500)

End Sub


 解説:
 ReadLine メソッドは、TextStream ファイルから 1 行 (改行文字を除く) を読み込み、その結果の文字列を返します。

object.ReadLine( )
object には、TextStream オブジェクトの名前を指定します。


 AtEndOfStream プロパティは、TextStream ファイル内でファイル ポインタがファイルの最後に置かれている場合に真 (true) を返します。それ以外の場合は、偽 (false) を返します。値の取得のみ可能です。
 AtEndOfStream プロパティが使用できるのは、読み取りを行うように開いた TextStream ファイルに対してだけです。それ以外の場合は、エラーが発生します。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る


ファイルを行ソート

 テキスト系のファイルを、行ソートします。
ソートは、ホームページで公開していただいている「クイック・ソート」のコードを、そのまま使わせていただいています。

 サクラエディタに付属のソート機能と比較したところ、こちらの方が3倍高速(1/3の処理時間)でした。

 いろいろなソートアルゴリズム★←ソートの過程を動画で理解できます!
http://www.ics.kagoshima-u.ac.jp/~fuchida/edu/algorithm/sort-algorithm/top.html

 起動させると、対象のファイルを聞いてくるので、指定します。
 次に、ソート方法として、数値ソートと、文字ソート(大文字小文字を区分するしない)の選択ができます。
 ソート結果のファイルが、対象のファイルと同じフォルダに、ソート方法の接尾語を付けて、作成されます。

SortTestData.txt ←ソートの結果比較用のテストデータとして使って下さい。

 漢字変数に置きなおしているので、ソートのアルゴリズムがコード上で分かりやすくなっていると思います。

注1:HotVBSの「編集」→「設定」→「スクリプト」の「ループ回数制限数」のチェックを外すか、もしくは、処理するデータ件数に合わせて、それなりに大きな数にしないと、ループ制限で止まります。

注2:行数が大きくて、VBScript でソートできない場合は、FreeBASIC のものを使ってみて下さい。


Option Explicit

   'ファイルを開くときの、初期ディレクトリ
   Const パス = "D:\"
   Dim 入力ファイルフルパス 'As String
   Dim 開始日時 'as Long
   Dim 終了日時 'as Long
   Dim YesNo
   Dim 比較モード
   Dim 拡張子
   Dim ソート方法
'************************************************
'★★★ファイル名の取得★★★
'************************************************

    Dim 検索結果

   FileDialog.InitialDir = パス
   'ファイルマスク(フィルタ)
   FileDialog.Filter = "テキスト・ファイル(*.txt,*.csv)|*.txt;*.csv"
   
   'ファイルを開くダイアログを表示
   '閉じるとき、ファイルが選択されたらTrue、
   'キャンセルされたらFalseを返します
   検索結果 = FileDialog.ShowOpen
    If 検索結果 = False Then
        HotVBS.Quit
    Else
        入力ファイルフルパス = FileDialog.FileName ?
    End If

   YesNo = MsgBox ("数値ソートですか?(はい:数値ソート、いいえ:文字ソート)" _
   , 36, "ソート方法を選択(数値と、文字バイナリの結果は同じ?)")
   ? YesNo
   If YesNo = 6 Then 
      ソート方法 = "数値ソート"
   ElseIf  YesNo = 7 Then 
      ソート方法 = "文字ソート"
   Else 
      ソート方法 = "数値ソート"
   End If
   
   比較モード = 0
        
    If ソート方法 = "文字ソート" Then    
      YesNo = MsgBox ("大文字と小文字を区別しますか(はい:0バイナリ、いいえ:1テキスト)" _
      , 36, "StrComp の比較モード")
      ? YesNo
      If YesNo = 6 Then 
         比較モード = vbBinaryCompare
      ElseIf  YesNo = 7 Then 
         比較モード = vbTextCompare
      Else 
         比較モード = vbBinaryCompare
      End If
   End If
        
    開始日時 = Now
        
    Call テキストソート(入力ファイルフルパス, ソート方法, 比較モード)

    終了日時 = Now
    MsgBox "ソートを終わりました。" & vbNewLine _
    & "処理時間は、" _
    & FormatDateTime(終了日時 - 開始日時) & " でした。"


Sub テキストソート(入力ファイルフルパス, ソート方法, 比較モード)

   Dim 文字列配列()
   Dim 入力行数
   Dim 行
   Dim ファイルシステムオブジェクト
   Dim 出力ファイルフルパス
   Dim テキストファイル
   Dim 出力ファイル
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

      ' テキストファイルの内容読み込み処理
        入力行数 = 0
        Set テキストファイル = ファイルシステムオブジェクト.OpenTextFile(入力ファイルフルパス) ' テキストファイルのオープン
        Do Until テキストファイル.AtEndOfStream
         ReDim Preserve 文字列配列(入力行数)
            文字列配列(入力行数) = テキストファイル.ReadLine             ' 1行読み込み
         入力行数 = 入力行数 + 1
        Loop
        
        If ソート方法 = "数値ソート" Then
           Call 数値Sort(文字列配列, 0, 入力行数 - 1)        
        Else
           Call 文字Sort(文字列配列, 0, 入力行数 - 1, 比較モード)
        End If

   出力ファイルフルパス = Left(入力ファイルフルパス, Len(入力ファイルフルパス) - 4) _
   & ソート方法 & 比較モード & "Sorted." & Right(入力ファイルフルパス, 3)

   Set 出力ファイル = ファイルシステムオブジェクト.CreateTextFile(出力ファイルフルパス)

   For 行 = 0 To 入力行数 - 1
       出力ファイル.WriteLine 文字列配列(行)
   Next

   テキストファイル.Close
   出力ファイル.Close

End Sub

'************************************************
'★★★文字ソート★★★
'Sub 文字Sort _
'    (ByRef テキスト配列() , _
'     ByVal 開始行 , _
'     ByVal 終了行 )
   
Sub 文字Sort (ByRef テキスト配列() , ByVal 開始行 , ByVal 終了行 , 比較モード)

   '林道の鬼
   'http://www.geocities.co.jp/SilkRoad/4511/vb/strsort.htm
   'を、変数名を漢字に変更して、使わせていただいています。
   '転載の承認をいただき、有難うございました。
   '----- StrSort Ver 1.00 -----
   '文字列型(String)配列をソートします。
   '
   '引数 テキスト配列()
   '   ソート対象となる文字列型(String)配列を指定します。
   '       テキスト配列(0) = "Error"
   '       テキスト配列(1) = "Aho no Sakata"
   '       テキスト配列(2) = "Cool"
   '   の配列を渡した場合、
   '       テキスト配列(0) = "Aho no Sakata"
   '       テキスト配列(1) = "Cool"
   '       テキスト配列(2) = "Error"
   '   のように正順に整列されます。
   '
   '引数 開始行
   '   ソートを開始する配列の要素番号を指定します。
   '
   '引数 終了行
   '   ソートを終了する配列の要素番号を指定します。
   '
   '引数 比較モード
   '   省略可能です。文字列比較のモードを指定する番号を設定します。
   '
   '   vbBinaryCompare - バイナリ モードの比較を行います。
   '   vbTextCompare   - テキスト モードの比較を行います。
   '
   '   この引数を省略すると vbBinaryCompare が適用されます。
   '
   'ソートにはクイックソートアルゴリズムを使用し、文字列比較には
   'StrComp 関数を使用しています。ソートアルゴリズム自体は
   '高速なのですが、可変長文字列型配列を扱うため処理速度は決して
   '速いとはいえません。


 Dim 中央の要素番号                                           '中央の要素番号を格納する変数
 Dim 基準値                                                   '基準値を格納する変数
 Dim 格納位置カウンタ                                         '格納位置カウンタ
 Dim 一時待避                                                 '値をスワップするための作業域
 Dim i                                                        'ループカウンタ
 
    If 開始行 >= 終了行 Then Exit Sub                         '終了番号が開始番号以下の場合、プロシージャを抜ける
    中央の要素番号 = (開始行 + 終了行) \ 2                    '中央の要素番号を求める
    基準値 = テキスト配列(中央の要素番号)                     '中央の値を基準値とする
    テキスト配列(中央の要素番号) = テキスト配列(開始行)       '中央の要素に開始番号の値を格納
    格納位置カウンタ = 開始行                                 '格納位置カウンタを開始番号と同じにする
    For i = (開始行 + 1) To 終了行 Step 1                     '開始番号の次の要素から終了番号までループ
        If StrComp(テキスト配列(i), 基準値, 比較モード) = - 1 Then        '値が基準値より小さい場合
            格納位置カウンタ = 格納位置カウンタ + 1           '格納位置カウンタをインクリメント
            一時待避 = テキスト配列(格納位置カウンタ)         'テキスト配列(i) と テキスト配列(格納位置カウンタ) の値をスワップ
            テキスト配列(格納位置カウンタ) = テキスト配列(i)
            テキスト配列(i) = 一時待避
        End If
    Next
    テキスト配列(開始行) = テキスト配列(格納位置カウンタ)     'テキスト配列(格納位置カウンタ) を開始番号の値にする
    テキスト配列(格納位置カウンタ) = 基準値                   '基準値を テキスト配列(格納位置カウンタ) に格納
    Call 文字Sort(テキスト配列, 開始行, 格納位置カウンタ - 1, 比較モード)  '分割された配列をクイックソート(再帰)
    Call 文字Sort(テキスト配列, 格納位置カウンタ + 1, 終了行, 比較モード)  '分割された配列をクイックソート(再帰)

End Sub
	
'************************************************
'★★★数値ソート★★★
Sub 数値Sort(ByRef データ配列() , ByVal 開始行 , ByVal 終了行)

'よねさんのWordとExcelの小部屋
'http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_array2.html
'を、VBScript用に、変数宣言を変更するとともに、変数を漢字化して、使わせていただいています。
'転載の承認をいただき、有難うございました。

    Dim i
    Dim j
    Dim 中央の要素番号
    Dim 一時待避
        中央の要素番号 = データ配列(Int((開始行 + 終了行) / 2))
        i = 開始行
        j = 終了行
        Do
            Do While データ配列(i) < 中央の要素番号
                i = i + 1
            Loop
            Do While データ配列(j) > 中央の要素番号
                j = j - 1
            Loop
            If i >= j Then Exit Do
            一時待避 = データ配列(i)
            データ配列(i) = データ配列(j)
            データ配列(j) = 一時待避
            i = i + 1
            j = j - 1
      Loop
      If (開始行 < i - 1) Then 数値Sort データ配列, 開始行, i - 1
      If (終了行 > j + 1) Then 数値Sort データ配列, j + 1, 終了行
End Sub

 解説:
 Dim ステートメントは、変数を宣言してメモリ領域を割り当てます。
 VBScript の変数は、バリアント型 (Variant) のみを使います。VBScript では、変数に As 句を使って、変数型を指定することはできません。


 StrComp 関数は、文字列比較の結果を表す値を返します。
StrComp(string1, string2[, compare])
 引数
string1
必ず指定します。任意の文字列式を指定します。
string2
必ず指定します。任意の文字列式を指定します。
compare
省略可能です。文字列式を評価するときに使用する文字列比較のモードを表す数値を指定します。
引数 compare を省略すると、バイナリ モードで比較が行われます。設定する値については、次の「設定値」を参照してください。
 設定値
 引数 compare の設定値は次のとおりです。
定数 内容
vbBinaryCompare 0 バイナリ モードで比較を行います。
vbTextCompare 1 テキスト モードで比較を行います。

 戻り値
 StrComp 関数の戻り値は次のとおりです。
条件 StrComp の戻り値
string1 は string2 未満 -1
string1 と string2 は等しい 0
string1 は string2 を超える 1
string1 または string2 は Null 値 Null 値

 使用例
 次のコードは、StrComp 関数を使って文字列比較の結果を返す例です。3 番目の引数が 1 の場合は、テキスト モードで比較を行い、0 または省略された場合は、バイナリ モードで比較を行います。
Dim MyStr1, MyStr2, MyComp
MyStr1 = "ABCD": MyStr2 = "abcd"    ' 変数を定義します。
MyComp = StrComp(MyStr1, MyStr2, 1)   ' 0 を返します。
MyComp = StrComp(MyStr1, MyStr2, 0)   ' -1 を返します。
MyComp = StrComp(MyStr2, MyStr1)      ' 1 を返します。



 FormatDateTime 関数は、日付形式または時刻形式の文字列に書式設定して返す文字列処理関数です。
FormatDateTime(Date[, NamedFormat])
 引数
Date
必ず指定します。書式を変換する日付式を指定します。
NamedFormat
省略可能です。使用されている日付/時刻形式を表す数値を指定します。
省略すると、定数 vbGeneralDate が使用されます。
 設定値
 引数 NamedFormat の設定値は次のとおりです。
定数 内容
vbGeneralDate 0 日付か時刻、または両方を表示します。
日付部がある場合は、日付を短い形式で表示します。
時刻部がある場合は、時刻を長い形式で表示します。
両方がある場合は、両方とも表示します。
vbLongDate 1 [地域のプロパティ] で指定されている長い形式で日付を表示します。
vbShortDate 2 [地域のプロパティ] で指定されている短い形式で日付を表示します。
vbLongTime 3 [地域のプロパティ] で指定されている形式で時刻を表示します。
vbShortTime 4 24 時間形式 (hh:mm) で時刻を表示します。

 使用例
 次のコードは、FormatDateTime 関数を使って式を長整数型 (Long) に設定し、MyDateTime に割り当てます。
Function GetCurrentDate
   ' 日付を長整数型 (Long) に設定します。
   GetCurrentDate = FormatDateTime(Date, 1) 
End Function



 FileDialogオブジェクト は、HotVBS の専用オブジェクトで、ファイルダイアログのユーザーインターフェースです。

'FileDialogオブジェクトのプロパティ(設定/取得)

 FileDialog.Filter = "テキストファイル(*.txt)|*.txt|対応ファイル(*.txt,*.pas)|*.txt;*.pas|全てのファイル(*.*)|*.*"
S = FileDialog.Filter ?
'ファイルダイアログの、ファイルマスク(フィルタ)を設定/取得します。
'フィルター名と、フィルター文字の間は、| 区切りです。
'複数フィルタ(同時に複数拡張子を表示するとき)の、フィルター文字の間は ; 区切りです。
'フィルタは、複数指定可能で、各フィルターは | 区切りです。

 FileDialog.FileName = HotVBS.ExePath & "Test"
S = FileDialog.FileName ?
'ファイルダイアログの、ファイル名をフルパスで設定/取得します。

 FileDialog.Title = "スクリプト"
S = FileDialog.Title ?
'ファイルダイアログの上部に表示される、タイトルを設定/取得します。

 FileDialog.FilterIndex = 1
S = FileDialog.FilterIndex ?
'ファイルダイアログが開いたときに、デフォルトで選択されている、
'フィルターの番号(インデックス)を設定/取得します。
'FilterIndex = 1 が最初のフィルターに対応します。

 FileDialog.DefaultExt = "txt"
S = FileDialog.DefaultExt ?
'ファイルダイアログの、デフォルトのファイル拡張子を設定/取得します。
'ファイル名との間の、.は不要です。
'FileNameに、Windowsに登録済みの拡張子が付いていない場合は、FileNameに
'DefaultExtが自動付加されます。

 FileDialog.FileName = HotVBS.ExePath & "Test"
S = FileDialog.FileName ?
'ファイルダイアログの、ファイル名をフルパスで設定/取得します。

 FileDialog.InitialDir = HotVBS.ExePath
S = FileDialog.InitialDir ?
'ファイルダイアログが開いたときの、カレントディレクトリを設定/取得します。

 FileDialog.AllowMultiSelect = True
・ファイルダイアログの複数ファイル選択対応

'FileDialogオブジェクトのメソッド

 ? FileDialog.ShowOpen
'[開く]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。

 ? FileDialog.ShowSave
'[保存]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。




 MsgBox 関数 は、ダイアログ ボックスにメッセージを表示し、ボタンがクリックされるのを待って、どのボタンがクリックされたかを示す値を返します。
MsgBox(prompt[, buttons][, title][, helpfile, context])
引数
prompt
ダイアログ ボックス内にメッセージとして表示する文字列を示す文字列式を指定します。引数 prompt に指定できる最大文字数は、1 バイト文字で約 1,024 文字です。ただし、使う文字の文字幅に依存します。引数 prompt に複数行を指定するには、改行する場所にキャリッジ リターン (Chr(13))、ライン フィード (Chr(10))、またはキャリッジ リターンとライン フィードの組み合わせ (Chr(13) & Chr(10)) を挿入してください。
buttons
表示されるボタンの種類と個数、使用するアイコンのスタイル、標準ボタン、メッセージ ボックスがモーダルかどうかなど、それらを表す値の合計値を示す数式を指定します。設定する値については、次の「設定値」を参照してください。省略すると、引数 buttons の既定値である 0 になります。
title
ダイアログ ボックスのタイトル バーに表示する文字列を示す文字列式を指定します。引数 title を省略すると、タイトル バーにはアプリケーション名が表示されます。
helpfile
ダイアログ ボックスに状況依存のヘルプを設定するために、使用するヘルプ ファイルの名前を示す文字列式を指定します。この引数は、表示するダイアログ ボックスの説明を、ヘルプを使って表示するときに指定します。引数 helpfile を指定した場合は、引数 context も指定する必要があります。16 ビット版のプラットフォームでは、利用できません。
context
ヘルプ トピックに指定したコンテキスト番号を表す数式を指定します。引数 context を指定した場合は、引数 helpfile も指定する必要があります。16 ビット版のプラットフォームでは、利用できません。
 設定値
 引数 buttons には、次の値のうち、該当する値の合計値を指定します。
定数 内容
vbOKOnly    0 [OK] ボタンのみを表示します。
vbOKCancel    1 [OK] ボタンと [キャンセル] ボタンを表示します。
vbAbortRetryIgnore    2 [中止]、[再試行]、および [無視] の 3 つのボタンを表示します。
vbYesNoCancel    3 [はい]、[いいえ]、および [キャンセル] の 3 つのボタンを表示します。
vbYesNo    4 [はい] ボタンと [いいえ] ボタンを表示します。
vbRetryCancel    5 [再試行] ボタンと [キャンセル] ボタンを表示します。
vbCritical 16 警告メッセージ アイコンを表示します。
vbQuestion 32 問い合わせメッセージ アイコンを表示します。
vbExclamation 48 注意メッセージ アイコンを表示します。
vbInformation 64 情報メッセージ アイコンを表示します。
vbDefaultButton1    0 第 1 ボタンを標準ボタンにします。
vbDefaultButton2  256 第 2 ボタンを標準ボタンにします。
vbDefaultButton3  512 第 3 ボタンを標準ボタンにします。
vbDefaultButton4  768 第 4 ボタンを標準ボタンにします。
vbApplicationModal    0 アプリケーション モーダルに設定します。メッセージ ボックスに応答するまで、現在選択中のアプリケーションの実行を継続できません。
vbSystemModal 4096 システム モーダルに設定します。メッセージ ボックスに応答するまで、すべてのアプリケーションが中断されます。
 最初のグループに属する値 (0 〜 5) は、ダイアログ ボックスに表示されるボタンの種類と個数を指定します。
 次のグループに属する値 (16、32、48、64) は、アイコンの種類を指定します。
 第 3 のグループに属する値 (0、256、512、768) は、どのボタンが標準ボタンになるかを指定します。
 最後のグループに属する値 (0、4096) は、メッセージ ボックスがモーダルかどうかを指定します。
 引数 buttons の値を設定するには、各グループから値を 1 つずつ選択して加算した合計値を指定します。
 戻り値
 MsgBox 関数の戻り値は次のとおりです。
定数 選択されたボタン
vbOK 1 [OK]
vbCancel 2 [キャンセル]
vbAbort 3 [中止]
vbRetry 4 [再試行]
vbIgnore 5 [無視]
vbYes 6 [はい]
vbNo 7 [いいえ]
 解説
 引数 helpfile および引数 context を指定すると、F1 キーを押すことにより、コンテキスト番号に対応したヘルプ トピックを参照できます。
 [キャンセル] ボタンが表示されているダイアログ ボックスでは、Esc キーを押すと、[キャンセル] をクリックしたときと同じ結果になります。ダイアログ ボックスに [ヘルプ] ボタンが表示されているときは、そのダイアログ ボックスには状況依存のヘルプが設定されています。ただし、[ヘルプ] ボタン以外のボタンがクリックされるまでは、値を返しません。
 Microsoft Internet Explorer で MsgBox 関数が使用されている場合は、表示されるダイアログ ボックスのタイトルに常に "VBScript:"が含まれ、標準のシステム ダイアログ ボックスと区別されます。

 次のコードは、MsgBox 関数を使って、メッセージ ボックスを表示し、どのボタンがクリックされたかを説明する値を返す例です。
Dim MyVar
MyVar = MsgBox ("Hello World!", 65, "MsgBox の例")
   ' MyVar の値は、クリックされたボタンによって、1 または 2 になります。



 Now 関数 は、コンピュータのシステムの日付と時刻の設定に基づいて、現在の日付と時刻を返します。

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

複数ファイルを複数行置換(下位フォルダ含む)


*********************************************
特長:
(1).複数の正規表現置換パターンを、辞書ファイルから読み込んで、連続置換
(2).同一フォルダに登録した、複数の同一拡張子のフォルダを、一括置換
(3).置換パターンに、改行文字を含めることで、「一行→複数行」「複数行→一行」「複数行→複数行」の置換も可能
*********************************************
使い方
(1).置換パターンの辞書を作成します。
 @.ファイル名は、「複数行置換辞書.txt (SampleDictionary.zip)」で固定。
辞書データの作り方のサンプル ↑ として、私のhtml整形用辞書をダウンロードできます。
 A.置換前 置換後 :備考、の形式で登録。備考は、付けても付けなくてもOKです。
  (置換前、置換後、備考の間はTabで区切る。備考の前には:を付ける。)
 B.置換前 置換後には、正規表現を使います。
メタ文字を置換対象とするときは、エスケープキャラクタ \ を前に付けます。

   . * ? + ( ) { } [ ] ^ $ \ |
 C.置換後に使える正規表現は、「改行」と「タブ」のみです。置換後の文字列では、メタ文字は通常文字となります。
  改行文字は「\r\n」、タブは「\t」を用います。
  例:
<SCRIPT type="text/javascript">\r\n<!-- \r\nparent\.document\.title = 'VerticalEditor:' \+ document\.title;\r\n//-->\r\n</SCRIPT>		:5行削除。+はメタ文字なので、エスケープキャラクタ \ を前に付ける。
<BODY onLoad="cookie_css\(\)">	<BODY>	:置換。( )はメタ文字なので、エスケープキャラクタ \ を前に付ける。
 +\r\n	\r\n	:行末の半角空白を削除
(\t)+\r\n	\r\n	:行末のタブを削除
\r\n(\r\n)+	\r\n\r\n	:連続する空行を1行にする
 D.後方参照を使うと、"( )"でグループ化した文字列を再度利用することができます。
   置換文字列を指定するときに後方参照を利用する場合は、"$"文字の後にグループの番号を数字で指定します。
 E.置換は、辞書に登録した順に処理します。結果は、登録順に依存するので注意して下さい。
  (上の例の順では、まず行末の空白を削除して、空白行にした後で、連続する空白行を判定します。)

(2).置換したいファイル群と、「複数行置換辞書.txt」を、同一のフォルダに保存する。
 @.置換するファイル群は、Shift JIS なら、拡張子は何でもOK。
 A.ファイルを上書きします。重要なファイルは、別フォルダにバックアップを保存しておいて下さい。
(3).スクリプトを、動かす。
(4).ファイルを開くダイアログが表示されるので、置換対象のファイルの、「どれか一つ」を選択する。
 (目的は、対象フォルダと、拡張子を、特定するためだけです。)

(5).選択したファイルと同一拡張子のファイルについて、辞書を使って置換が行われる。
(6).このスクリプトを実行したことによる結果について、責任は持てませんので悪しからず。

*********************************************
謝辞:正規表現を使った置換のコードは、下記を使わせていただきました。
http://sakura.qp.land.To/?Macro%2F%C5%EA%B9%C6%2F146
【作 者】maru
【名 称】wshReplace2.vbs
【機 能】WSHのRegExpを使った簡易な複数行置換マクロ
*********************************************
'再帰を使用したサブフォルダの列挙
'http://gallery.technet.microsoft.com/scriptcenter/39273856-c605-4e10-8580-6e733bd16add
'http://gallery.technet.microsoft.com/scriptcenter/202f2497-c0e3-4bea-b421-dca776c5c578
'*********************************************

■変更経歴:
 ' 2010/04/03 作成
 ' 2010/06/26 置換されたファイルのみ更新するように変更
 ' 2010/08/08 置換後にtabが使えなかったバグを修正
 ' 2010/09/04 下位フォルダも含められるように機能追加
 ' 2012/11/11 変換後に後方参照が使えることを追記


Dim ファイル名 'As String
Dim ファイルシステムオブジェクト 'As Object          ' FileSystemObject
Dim 入力テキストストリームオブジェクト 'As Object    ' TextStream
Dim 出力テキストストリームオブジェクト 'As Object    ' TextStream
Dim 現在のパス 'As String
Dim フォルダ 'As Object
Dim サブフォルダ 'As Variant
Dim 処理フォルダ 'As String
Dim ファイル 'As Object
Dim 開始日時 'As Variant
Dim 終了日時 'As Variant
Dim 分
Dim 辞書配列()
Dim 辞書件数
Dim 初期パス
Dim 初期ファイル
Dim 検索結果
Dim 置換パターン
Dim 正規表現オブジェクト
Dim 置換前
Dim 置換後
Dim ファイル内容
Dim 置換前ファイル内容
Dim 対象ファイル拡張子
Dim 辞書ファイル名
Dim 入力行
Dim 繰返し
Dim 検索ファイル数
Dim 対象ファイル数
Dim 第一タブ位置
Dim 置換後までの文字数
Dim 回答
Dim 置換ファイル数

Private Sub 複数行置換

   'RegExpオブジェクト生成
   Set 正規表現オブジェクト = New RegExp
	
   '前もって、改行コードをCRLFに統一する
   '1)CRLF(WINDOWS)→LF(UNIX) いったんラインフィード(Line Feed)に方違え
      正規表現オブジェクト.Pattern = "\r\n"
      正規表現オブジェクト.Global = True '文字列全体で、検索を適用する。
      ファイル内容 = CStr(正規表現オブジェクト.Replace(ファイル内容, vbLf))
   '2)CR(MAC)→LF(UNIX) いったんラインフィード(Line Feed)に方違え
      正規表現オブジェクト.Pattern = "\r"
      正規表現オブジェクト.Global = True '文字列全体で、検索を適用する。
      ファイル内容 = CStr(正規表現オブジェクト.Replace(ファイル内容, vbLf))
   '3)LF(UNIX)→CRLF 改行コードをCRLF(WINDOWS)に統一
      正規表現オブジェクト.Pattern = "\n"
      正規表現オブジェクト.Global = True '文字列全体で、検索を適用する。
      ファイル内容 = CStr(正規表現オブジェクト.Replace(ファイル内容, VbCrLf))
   
   '辞書データの一件ずつで、置換
   For 繰返し = 1 To 辞書件数
      置換パターン = 辞書配列(繰返し)
      '? 繰返し
      第一タブ位置 = InStr(置換パターン, vbTab)
      
      '置換前切り出し
      置換前 = Left(置換パターン, 第一タブ位置 - 1) 

      '置換後切り出し
      If InStr(第一タブ位置 + 1, 置換パターン, vbTab) = 0 Then '第二Tab が無い。
         置換後までの文字数 = Len(置換パターン)
      Else
         置換後までの文字数 = InStr(第一タブ位置 + 1, 置換パターン, vbTab) - 1 
      End If
      置換後 = Mid(置換パターン, 第一タブ位置 + 1, 置換後までの文字数 - 第一タブ位置 )

      'WSHのRegExpでは置換後にエスケープ文字が使えないので、ここで変換しておく
      '置換後文字列の改行コード生成
      正規表現オブジェクト.Pattern = "\\r"
      正規表現オブジェクト.Global = True
      置換後 = 正規表現オブジェクト.Replace(置換後, vbCr) ?
      正規表現オブジェクト.Pattern = "\\n"
      正規表現オブジェクト.Global = True
      置換後 = 正規表現オブジェクト.Replace(置換後, vbLf) ?
      '置換後文字列の水平タブ生成
      正規表現オブジェクト.Pattern = "\\t"
      正規表現オブジェクト.Global = True
      置換後 = 正規表現オブジェクト.Replace(置換後, vbTab) 

      '置換処理
      正規表現オブジェクト.Pattern = 置換前
      正規表現オブジェクト.IgnoreCase = True '大文字小文字を区別しない。
      正規表現オブジェクト.Global = True '文字列全体で、検索を適用する。
      ファイル内容 = CStr(正規表現オブジェクト.Replace(ファイル内容, 置換後))
      
   Next
   
   Set 正規表現オブジェクト = Nothing
End Sub


'*********************************************
'*********** 処理内容 ************************
'*********************************************

   'ファイルマスク(フィルタ)
   FileDialog.Filter = "対応ファイル(*.txt,*.*htm*)|*.txt;*.*htm*|全てのファイル(*.*)|*.*"

   初期パス = "D:\"
   'ファイルダイアログが開いたときの、カレントディレクトリを設定します。
   FileDialog.InitialDir = 初期パス      ?

   '[開く]ボタンの付いた、ファイルダイアログを表示します。
   '設定されるとTrue、キャンセルされるとFalseを返します。
   検索結果 = FileDialog.ShowOpen     ?
   If 検索結果 = False Then HotVBS.Quit   '終了★
   初期ファイル = FileDialog.FileName     ?
   対象ファイル拡張子 = Right(初期ファイル, Len(初期ファイル) - InStrRev(初期ファイル, ".")) ?


   現在のパス = Left(初期ファイル, InStrRev(初期ファイル, "\") - 1) ?

   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   '辞書ファイルを読み込む。辞書ファイル名は、「複数行置換辞書.txt」決め打ち。
   ' 指定ファイルをOPEN(入力モード)
   辞書ファイル名 = 現在のパス & "\" & "複数行置換辞書.txt" ?
   Set 入力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.OpenTextFile(辞書ファイル名, 1)
   辞書件数 = 0 ?
   Do Until 入力テキストストリームオブジェクト.AtEndOfStream
      辞書件数 = 辞書件数 + 1 ?
      入力行 = 入力テキストストリームオブジェクト.readLine ?
   
      If InStr(入力行, vbTab) = 0 Then 'Tab が無い。
         MsgBox 辞書件数 & " 行目の辞書データが不正です。(Tab が無い。)" & vbNewLine _
         & 入力行
         'Scriptを中断します。
         HotVBS.Quit   '終了★
      Else
         第一タブ位置 = InStr(入力行, vbTab) ?
      End If
   
      '置換前切り出し
      置換前 = Left(入力行, InStr(入力行, vbTab) - 1) ?
      If 置換前 = "" Then '置換前の文字列が無い。
         MsgBox 辞書件数 & " 行目の辞書データが不正です。(置換前の文字列が無い。)" & vbNewLine _
         & 入力行
         'Scriptを中断します。
         HotVBS.Quit   '終了★
   End If
   
      '置換後切り出し
      ? InStr(第一タブ位置 + 1, 入力行, vbTab)
      If InStr(第一タブ位置 + 1, 入力行, vbTab) = 0 Then '第二Tab が無い。
         If InStr(第一タブ位置 + 1, 入力行, ":") <> 0 _
            Or InStr(第一タブ位置 + 1, 入力行, ":") <> 0 Then '備考の前のTab 欠落?。
            回答 = MsgBox (辞書件数 & " 行目の辞書データの確認です。" & vbNewLine _
            & 入力行 & vbNewLine _
            & "変換後の頭が:です。変換後の文字列として:以下を使いますか?", 292, ":の意味を確認") ?
         If 回答 = 6 Then 'はい
            置換後までの文字数 = Len(入力行)
         ElseIf 回答 = 7 Then 'いいえ
            'Scriptを中断します。
            HotVBS.Quit   '終了★
         Else
            'Scriptを中断します。
            HotVBS.Quit   '終了★
         End If
      Else
         置換後までの文字数 = Len(入力行) 
      End If
   Else
         置換後までの文字数 = InStr(第一タブ位置 + 1, 入力行, vbTab) - 1 ?
   End If
   
   置換後 = Mid(入力行, 第一タブ位置 + 1, 置換後までの文字数 - 第一タブ位置 ) 
    
    ReDim Preserve 辞書配列(辞書件数)
    辞書配列(辞書件数) = 入力行
   Loop
   入力テキストストリームオブジェクト.Close
   Set 入力テキストストリームオブジェクト = Nothing


Set フォルダ = ファイルシステムオブジェクト.GetFolder(現在のパス)
検索ファイル数 = 0
対象ファイル数 = 0
置換ファイル数 = 0

'************************
'サブ・フォルダも対象とするかどうかの分岐
回答 = MsgBox ("サブ・フォルダのファイルも対象としますか?" & vbNewLine _
& "「はい」は、サブ・フォルダも対象にする。「いいえ」は、このファイルのフォルダのみ。" _
, 292, "サブ・フォルダも対象とするかどうか確認") 

' 開始時刻を変数に格納します。
開始日時 = Now

If 回答 = 6 Then 'はい:サブ・フォルダも対象にする
   Call 現在のフォルダ内の指定拡張子のファイルを置換
   Call サブフォルダ内の指定拡張子のファイルを置換(ファイルシステムオブジェクト.GetFolder(現在のパス))
Else
   Call 現在のフォルダ内の指定拡張子のファイルを置換
End If
'***********************
    
Set フォルダ = Nothing
Set ファイルシステムオブジェクト = Nothing

終了日時 = Now

MsgBox "処理を終了しました。" & vbNewLine _
& "検索ファイル数: " & 検索ファイル数  & vbNewLine _
& "対象ファイル数: " & 対象ファイル数  & vbNewLine _
& "置換パターン数: " & 辞書件数  & vbNewLine _
& "置換ファイル数: " & 置換ファイル数  & vbNewLine _
& "処理時間は、" & FormatDateTime(終了日時 - 開始日時) & " でした。"



Private Sub 現在のフォルダ内の指定拡張子のファイルを置換
   '★指定フォルダの全ての指定拡張子ファイルを対象
   For Each ファイル In フォルダ.Files

      ファイル名 = ファイル.Path ?
      検索ファイル数 = 検索ファイル数 + 1
      If 対象ファイル拡張子 = Right(ファイル名, Len(ファイル名) - InStrRev(ファイル名, ".")) _
      And InStr(ファイル名, "複数行置換辞書") = 0 Then '複数行置換辞書が含まれていれば、変換対象外
      
         対象ファイル数 = 対象ファイル数 + 1
      
         ' 指定ファイルをOPEN(入力モード)
         Set 入力テキストストリームオブジェクト = _
         ファイルシステムオブジェクト.OpenTextFile(ファイル名, 1)
         '*************データの読み込み***********
         ファイル内容 = 入力テキストストリームオブジェクト.ReadAll()
         入力テキストストリームオブジェクト.Close()
         Set 入力テキストストリームオブジェクト = Nothing
         Len(ファイル内容) ?
         If Len(ファイル内容) > 50 Then '文字数50以上のファイルのみを対象とする
            '明示的に、シフトJIS以外のものは、対象外とする
            If InStr(ファイル内容, "charset=gb2312") = 0 And InStr(ファイル内容, "charset=utf-8") = 0 Then
               置換前ファイル内容 = ファイル内容 
         
               Call 複数行置換
         
               '置換結果を、ファイルに上書きする。
               If StrComp(置換前ファイル内容, ファイル内容) <> 0 Then '置換された場合のみ
                  置換ファイル数 = 置換ファイル数 + 1
                  Set  出力テキストストリームオブジェクト = _
                  ファイルシステムオブジェクト.CreateTextFile(ファイル名, True)
                     出力テキストストリームオブジェクト.Write(ファイル内容)
                     出力テキストストリームオブジェクト.Close
                     Set 出力テキストストリームオブジェクト = Nothing
               End If
            End If
         End If
   
      End If
   Next '★ファイル
End Sub


Private Sub サブフォルダ内の指定拡張子のファイルを置換(Folder)
   '★指定フォルダの全てのサブフォルダの指定拡張子ファイルを対象
    For Each サブフォルダ In Folder.SubFolders
        処理フォルダ = サブフォルダ.Path
        Set フォルダ = ファイルシステムオブジェクト.GetFolder(処理フォルダ)

      Call 現在のフォルダ内の指定拡張子のファイルを置換
      Call サブフォルダ内の指定拡張子のファイルを置換(サブフォルダ)
      Set フォルダ = Nothing
   Next '☆フォルダ
End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

UTF-8版 複数ファイルを複数行置換

Shift JIS版 を、UTF-8のファイルで使えるようにしたものです。
 以下のコードは、Shift JIS版 と違なる、メイン部分のみです。

*********************************************
謝辞:下記サイトで公開いただいているコードを使わせていただきました。
 [wsh]JScriptでUTF-8ファイルを読んで置換して保存
https://hiro99ma.blogspot.com/2014/11/wshjscriptutf-8.html
 VBSで正規表現を使用してテキストの文字列を置換する
http://d.hatena.ne.jp/necoyama3/20081202/1228220710
*********************************************
■変更経歴:
' 2018/07/08 作成。BASP21 を使うバージョンをベースに、ADODB.Stream を使うように修正
' ShiftJIS の一時ファイルを使うと、SJIS にない文字(〜(U+301C)など)が化けるので直接処理に変更

'ファイルマスク(フィルタ)
FileDialog.Filter = "対応ファイル(*.txt,*.xml,*.*htm*)|*.txt;*.xml;*.*htm*|全てのファイル(*.*)|*.*"

初期パス = "D:\"
'ファイルダイアログが開いたときの、カレントディレクトリを設定します。
FileDialog.InitialDir = 初期パス      

'[開く]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。
FileDialog.Title = "UTF8版 複数File複数行置換"
検索結果 = FileDialog.ShowOpen     
If 検索結果 = False Then HotVBS.Quit   '終了★
初期ファイル = FileDialog.FileName     
対象ファイル拡張子 = Right(初期ファイル, Len(初期ファイル) - InStrRev(初期ファイル, ".")) ?

現在のパス = Left(初期ファイル, InStrRev(初期ファイル, "\") - 1) 

Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
'辞書ファイルを読み込む。辞書ファイル名は、「複数行置換辞書.txt」決め打ち。
' 指定ファイルをOPEN(入力モード)
辞書ファイル名 = 現在のパス & "\" & "複数行置換辞書.txt" 
Set 入力テキストストリームオブジェクト = _
ファイルシステムオブジェクト.OpenTextFile(辞書ファイル名, 1)
辞書件数 = 0 
ゼロサイズ数 = 0
Do Until 入力テキストストリームオブジェクト.AtEndOfStream
    辞書件数 = 辞書件数 + 1 
   入力行 = 入力テキストストリームオブジェクト.readLine 
   
   If InStr(入力行, vbTab) = 0 Then 'Tab が無い。
      MsgBox 辞書件数 & " 行目の辞書データが不正です。(Tab が無い。)" & vbNewLine _
      & 入力行
      'Scriptを中断します。
      HotVBS.Quit   '終了★
   Else
      第一タブ位置 = InStr(入力行, vbTab) 
   End If
   
   '置換前切り出し
   置換前 = Left(入力行, InStr(入力行, vbTab) - 1) 
   If 置換前 = "" Then '置換前の文字列が無い。
      MsgBox 辞書件数 & " 行目の辞書データが不正です。(置換前の文字列が無い。)" & vbNewLine _
      & 入力行
      'Scriptを中断します。
      HotVBS.Quit   '終了★
   End If
   
   '置換後切り出し
   If InStr(第一タブ位置 + 1, 入力行, vbTab) = 0 Then '第二Tab が無い。
      If InStr(第一タブ位置 + 1, 入力行, ":") <> 0 _
         Or InStr(第一タブ位置 + 1, 入力行, ":") <> 0 Then '備考の前のTab 欠落?。
         回答 = MsgBox (辞書件数 & " 行目の辞書データの確認です。" & vbNewLine _
         & 入力行 & vbNewLine _
         & "変換後の文字列に:が有ります。変換後の文字列として:以下を使いますか?", 292, ":の意味を確認") 
         If 回答 = 6 Then 'はい
            置換後までの文字数 = Len(入力行)
         ElseIf 回答 = 7 Then 'いいえ
            'Scriptを中断します。
            HotVBS.Quit   '終了★
         Else
            'Scriptを中断します。
            HotVBS.Quit   '終了★
         End If
      Else
         置換後までの文字数 = Len(入力行) 
      End If
   Else
      置換後までの文字数 = InStr(第一タブ位置 + 1, 入力行, vbTab) - 1 
   End If
   
   置換後 = Mid(入力行, 第一タブ位置 + 1, 置換後までの文字数 - 第一タブ位置 ) 
    
    ReDim Preserve 辞書配列(辞書件数)
    辞書配列(辞書件数) = 入力行
Loop

入力テキストストリームオブジェクト.Close
Set 入力テキストストリームオブジェクト = Nothing

Set フォルダ = ファイルシステムオブジェクト.GetFolder(現在のパス)
検索ファイル数 = 0
対象ファイル数 = 0
置換ファイル数 = 0
指定charset = ""

'************************
'サブ・フォルダも対象とするかどうかの分岐
回答 = MsgBox ("サブ・フォルダのファイルも対象としますか?" & vbNewLine _
& "「はい」は、サブ・フォルダも対象にする。「いいえ」は、このファイルのフォルダのみ。" _
, 292, "サブ・フォルダも対象とするかどうか確認") 

開始日時 = Now

If 回答 = 6 Then 'はい:サブ・フォルダも対象にする
   Call 現在のフォルダ内の指定拡張子のファイルを置換
   Call サブフォルダ内の指定拡張子のファイルを置換(ファイルシステムオブジェクト.GetFolder(現在のパス))
Else
   Call 現在のフォルダ内の指定拡張子のファイルを置換
End If
'***********************
    
Set フォルダ = Nothing
Set ファイルシステムオブジェクト = Nothing

終了日時 = Now

MsgBox "処理を終了しました。" & vbNewLine _
& "検索ファイル数: " & 検索ファイル数  & vbNewLine _
& "対象ファイル数: " & 対象ファイル数  & vbNewLine _
& "置換パターン数: " & 辞書件数  & vbNewLine _
& "置換ファイル数: " & 置換ファイル数  & vbNewLine _
& "ゼロサイズ数: " & ゼロサイズ数  & vbNewLine _
& "処理時間は、" & FormatDateTime(終了日時 - 開始日時) & " でした。"


Private Sub 現在のフォルダ内の指定拡張子のファイルを置換
   '★指定フォルダの全ての指定拡張子ファイルを対象
   For Each ファイル In フォルダ.Files

     If ファイル.size > 0 Then

      ファイル名 = ファイル.Path ?
      検索ファイル数 = 検索ファイル数 + 1
      If 対象ファイル拡張子 = Right(ファイル名, Len(ファイル名) - InStrRev(ファイル名, ".")) _
      And InStr(ファイル名, "複数行置換辞書") = 0 Then '複数行置換辞書が含まれていれば、変換対象外
      
         対象ファイル数 = 対象ファイル数 + 1
      
         '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
         ' 入力用の UTF-8 の"ADODB.Stream"オブジェクトを得る
         Set objUTF8 = CreateObject("ADODB.Stream")

         ' 指定ファイルをOPEN(入力モード)
         objUTF8.Type = 2    ' adTypeText
         objUTF8.Charset = "UTF-8"
         objUTF8.Open
         objUTF8.LoadFromFile (ファイル名)

         ファイル内容 = objUTF8.ReadText(-1)       '-1:全部 -2:1行ごと

         objUTF8.Close
         Set objUTF8 = Nothing
         '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
      
         ? ファイル名
           ファイル.size ?
         If ファイル.size > 0 Then

         If Len(ファイル内容) > 50 Then '文字数50以上のファイルのみを対象とする
         '★★★★★明示的に、シフトJISは、原則として対象外とする
         If (InStr(ファイル内容, "charset=Shift_JIS") = 0 And InStr(ファイル内容, "charset=x-sjis") = 0 ) _
         Or 指定charset <> "" Then
         
            置換前ファイル内容 = ファイル内容 
         
            Call 複数行置換
         
            '置換結果を、ファイルに上書きする。
            If StrComp(置換前ファイル内容, ファイル内容) <> 0 Then '置換された場合のみ
               置換ファイル数 = 置換ファイル数 + 1

               '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
               '置換処理後のファイル内容を、UTF8で「ファイル名」として保存する。

               ' 出力用の UTF-8 の"ADODB.Stream"オブジェクトを得る
               Set objUTF8 = CreateObject("ADODB.Stream")

               'UTF-8形式で保存する
               objUTF8.Type = 2    ' adTypeText
               objUTF8.Charset = "UTF-8"
               objUTF8.Open
               objUTF8.WriteText ファイル内容, 1    '//0:改行無し 1:改行有り

               On Error Resume Next   'ファイル・サイズ 0 でエラーになるのを回避
               'https://msdn.microsoft.com/ja-jp/library/cc364220.aspx
               objUTF8.SaveTofile (ファイル名), 2 'adSaveCreateOverWrite 上書きを許す

               objUTF8.Close
               Set objUTF8 = Nothing
               '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
            End If
            
         Else
            回答 = MsgBox ("Shift_JISの明示が見つかりました。" & vbNewLine _
            & ファイル名 & vbNewLine _
            & "このファイルも対象としますか?" & vbNewLine _
            & "「はい」は、Shift_JIS も対象にする。「いいえ」は、処理を終了します。" _
            , 292, "Shift_JIS も対象とするかどうか確認") 

            If 回答 = 6 Then 'はい:Shift_JIS も対象とする
               指定charset = "Shift_JIS も対象" 
               ? ファイル名
               置換前ファイル内容 = ファイル内容 
                  
               Call 複数行置換
         
               '置換結果を、ファイルに上書きする。
               If StrComp(置換前ファイル内容, ファイル内容) <> 0 Then '置換された場合のみ
                  置換ファイル数 = 置換ファイル数 + 1
                        
               '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
               '置換処理後のファイル内容を、UTF8で「ファイル名」として保存する。

               ' 出力用の UTF-8 の"ADODB.Stream"オブジェクトを得る
               Set objUTF8 = CreateObject("ADODB.Stream")
               
               'UTF-8形式で保存する
               objUTF8.Type = 2    ' adTypeText
               objUTF8.Charset = "UTF-8"
               objUTF8.Open
               outStream.WriteText ファイル内容, 1    '//0:改行無し 1:改行有り

               On Error Resume Next   'ファイル・サイズ 0 でエラーになるのを回避
               'https://msdn.microsoft.com/ja-jp/library/cc364220.aspx
               objUTF8.SaveTofile (ファイル名), 2 'adSaveCreateOverWrite 上書きを許す

               objUTF8.Close
               Set objUTF8 = Nothing
               '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
                        
               End If
            Else
               Exit Sub
            End If
         End If
         End If '明示的に、シフトJISを対象とするか
         End If '50文字か
      End If '対象ファイル拡張子
     Else
      ゼロサイズ数 = ゼロサイズ数 + 1   
      ファイル名 = ファイル.Path ?
     End If 'ファイルサイズ>0
   Next '★ファイル
End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

複数のUTF8ファイルをShiftJISに一括変換(下位フォルダ含む)


*********************************************
特長:
(1).ファイルを開くダイアログで拡張子を選択する
(2).同一フォルダに以下に登録した、複数のフォルダを、一括変換
*********************************************
使い方
(1).スクリプトを、動かす。
(2).ファイルを開くダイアログが表示されるので、置換対象のファイルの、「どれか一つ」を選択する。
(目的は、対象フォルダと、拡張子を、特定するためだけです。)
(3).選択したファイルと同一拡張子のファイルについて、文字コード変換が行われる。
(4).このスクリプトを実行したことによる結果について、責任は持てませんので悪しからず。
*********************************************
謝辞:下記で公開いただいているプログラムを使わせていただきました。
 SJIS形式のファイルをUTF-8形式に変換して保存する
http://jazzmaster.hatenablog.com/entry/2012/05/28/210113
↑ファイルを開かずに丸ごと処理するので高速です。

 ADODB.Streamを使ったテキストファイルの読み書き
https://k-sugi.sakura.ne.jp/windows/vb/3650/
 Charset プロパティ
https://msdn.microsoft.com/ja-jp/library/cc364313.aspx
使える可能性のある文字コード
Windows-1250 Windows-1251 _iso-2022-jp$ESC big5 euc-jp gb2312 ibm852 ibm866 iso-2022-kr iso-8859-1 iso-8859-2 iso-8859-4 iso-8859-5 iso-8859-6 iso-8859-7 iso-8859-8 iso-8859-9 koi8-r ks_c_5601-1987 shift_jis utf-7 utf-8 windows-1252 windows-1255 windows-1256 windows-874
 再帰を使用したサブフォルダの列挙
http://www.microsoft.com/japan/technet/scriptcenter/scripts/storage/folders/stfovb10.mspx
*********************************************

Option Explicit

Dim ファイル名 'As String
Dim ファイルシステムオブジェクト 'As Object          ' FileSystemObject
Dim objSJIS ' SJIS 用の"ADODB.Stream"オブジェクト
Dim objUTF8 ' UTF-8 用の"ADODB.Stream"オブジェクト
Dim 現在のパス 'As String
Dim フォルダ 'As Object
Dim サブフォルダ 'As Variant
Dim 処理フォルダ 'As String
Dim ファイル 'As Object
Dim 開始日時 'As Variant
Dim 終了日時 'As Variant
Dim 分
Dim 初期パス
Dim 初期ファイル
Dim 検索結果
Dim 対象ファイル拡張子
Dim 繰返し
Dim 対象ファイル数
Dim 回答

'*********************************************
'*********** 処理内容 ************************
'*********************************************

'ファイルマスク(フィルタ)
FileDialog.Filter = "対応ファイル(*.txt,*.*htm*)|*.txt;*.*htm*|全てのファイル(*.*)|*.*"

初期パス = "D:\"
'ファイルダイアログが開いたときの、カレントディレクトリを設定します。
FileDialog.InitialDir = 初期パス      

'[開く]ボタンの付いた、ファイルダイアログを表示します。
'設定されるとTrue、キャンセルされるとFalseを返します。
検索結果 = FileDialog.ShowOpen     
If 検索結果 = False Then HotVBS.Quit   '終了★
初期ファイル = FileDialog.FileName     
対象ファイル拡張子 = Right(初期ファイル, Len(初期ファイル) - InStrRev(初期ファイル, ".")) ?

現在のパス = Left(初期ファイル, InStrRev(初期ファイル, "\") - 1) 

Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

' 指定ファイルをOPEN(入力モード)

Set フォルダ = ファイルシステムオブジェクト.GetFolder(現在のパス)

'************************
'サブ・フォルダも対象とするかどうかの分岐
回答 = MsgBox ("サブ・フォルダのファイルも対象としますか?" & vbNewLine _
& "「はい」は、サブ・フォルダも対象にする。「いいえ」は、このファイルのフォルダのみ。" _
, 36, "サブ・フォルダも対象とするかどうか確認") 

' 4   [はい] ボタンと [いいえ] ボタンを表示します。
'32   問い合わせメッセージ アイコンを表示します。
'256   第 2 ボタンを標準ボタンにします。
'0   第 1 ボタンを標準ボタンにします。

開始日時 = Now
対象ファイル数 = 0

If 回答 = 6 Then 'はい:サブ・フォルダも対象にする
   Call 現在のフォルダ内の指定拡張子のファイルを変換
   Call サブフォルダ内の指定拡張子のファイルを変換(ファイルシステムオブジェクト.GetFolder(現在のパス))
Else
   Call 現在のフォルダ内の指定拡張子のファイルを変換
End If
'***********************
    
Set フォルダ = Nothing
Set ファイルシステムオブジェクト = Nothing

終了日時 = Now

MsgBox "処理を終了しました。" & vbNewLine _
& "対象ファイル数: " & 対象ファイル数  & vbNewLine _
& "処理時間は、" & FormatDateTime(終了日時 - 開始日時) & " でした。"


Private Sub 現在のフォルダ内の指定拡張子のファイルを変換

   '★指定フォルダの全ての指定拡張子ファイルを対象
   For Each ファイル In フォルダ.Files

      ファイル名 = ファイル.Path
      If 対象ファイル拡張子 = Right(ファイル名, Len(ファイル名) - InStrRev(ファイル名, "."))  Then '対象拡張子ならば、変換対象外
      
         対象ファイル数 = 対象ファイル数 + 1
         
         ' SJISとUTF-8用の"ADODB.Stream"オブジェクトを得る

         Set objSJIS = CreateObject("ADODB.Stream")
         Set objUTF8 = CreateObject("ADODB.Stream")

         ' 指定ファイルをOPEN(入力モード)
         objUTF8.Type = 2    ' adTypeText
         objUTF8.Charset = "UTF-8"
         objUTF8.Open
         objUTF8.LoadFromFile (ファイル名)

         'Shift_JIS形式に変換して保存する

         objSJIS.Type = 2    ' adTypeText
         objSJIS.Charset = "Shift_JIS"
         objSJIS.Open
         
         On Error Resume Next   'ファイル・サイズ 0 でエラーになるのを回避
         objUTF8.CopyTo objSJIS  ' ここがポイント。文字を移しかえることで、文字コードの変換を行っている。
         'https://msdn.microsoft.com/ja-jp/library/cc364220.aspx
         objSJIS.SaveTofile (ファイル名), 2 'adSaveCreateOverWrite 上書きを許す

         objUTF8.Close
         objSJIS.Close
         
         Set objSJIS = Nothing
         Set objUTF8 = Nothing
      End If
   Next '★ファイル
End Sub

Private Sub サブフォルダ内の指定拡張子のファイルを変換(Folder)
   '★指定フォルダの全てのサブフォルダの指定拡張子ファイルを対象
    For Each サブフォルダ In Folder.SubFolders
        処理フォルダ = サブフォルダ.Path
        Set フォルダ = ファイルシステムオブジェクト.GetFolder(処理フォルダ)

      Call 現在のフォルダ内の指定拡張子のファイルを変換
      Call サブフォルダ内の指定拡張子のファイルを変換(サブフォルダ)
      Set フォルダ = Nothing
   Next '☆フォルダ
End Sub

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

階層付きテキストを第1レベルで分割


■用途:
階層付きテキストを1レベルをベースに、ファイル分割します。
2レベル以下は、レベルを一つ上げます。

■使い方
スクリプトを起動すると、ファイルを開くダイアログが開きます。
分割したいテキスト・ファイルを指定します。
同じフォルダに、指定ファイルの追番と、ノードをファイル名にして、保存します。


Dim 検索結果
Dim 入力ファイルフルパス
Dim 入力ファイル名拡張子無し
Dim 初期ファイル
Dim 開始日時
Dim 終了日時
Dim 現在のパス
Dim ファイルシステムオブジェクト
Dim ファイル
Dim テキスト
Dim 文字列配列
Dim 全体行数
Dim タイトル
Dim 追番
Dim 出力テキストストリームオブジェクト
Dim 出力ファイル名
Dim 開始行
Dim 出力行

Sub ファイル出力(出力ファイル名, 開始行)
   
   ' 指定ファイルをOPEN(出力モード)
   Set 出力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.CreateTextFile(出力ファイル名)
   
    '*************データの読み込み***********
    Do 
        出力行 = 文字列配列(開始行)
        出力テキストストリームオブジェクト.WriteLine 出力行         ' 改行(CrLf)付き
        開始行 = 開始行 + 1                                                                 ?
        
        If 全体行数 < 開始行 Then Exit Do
        
        If Left(文字列配列(開始行), 1) = "." And Mid(文字列配列(開始行), 2, 1) <> "." Then 
           タイトル = Trim(文字列配列(開始行))
         タイトル = Trim(Right(タイトル, Len(タイトル) - 1))                             ?
           Exit Do
        ElseIf Left(文字列配列(開始行), 1) = "." And Mid(文字列配列(開始行), 2, 1) = "." Then 
           文字列配列(開始行) = Right(文字列配列(開始行), Len(文字列配列(開始行)) - 1)     ?
        End If
        
    Loop ' 次の、第一レベルが来るまで繰り返す
    
   ' 指定ファイルをCLOSE
   出力テキストストリームオブジェクト.Close
   Set 出力テキストストリームオブジェクト = Nothing

End Sub


   FileDialog.Filter = "テキスト・ファイル(*.txt)|*.txt"
   
   'ファイルを開くダイアログを表示
   '閉じるとき、ファイルが選択されたらTrue、
   'キャンセルされたらFalseを返します
   検索結果 = FileDialog.ShowOpen
    If 検索結果 = False Then
        HotVBS.Quit
    Else
        入力ファイルフルパス = FileDialog.FileName                                          ?
    End If

    ' 開始時刻を変数に格納します。
    開始日時 = Now
    
   現在のパス = Left(入力ファイルフルパス, InStrRev(入力ファイルフルパス, "\") )           ?
   入力ファイル名拡張子無し _
   = Right(入力ファイルフルパス, Len(入力ファイルフルパス) - InStrRev(入力ファイルフルパス, "\") )
   入力ファイル名拡張子無し = Left(入力ファイル名拡張子無し, Len(入力ファイル名拡張子無し) - 4) ?
   '入力ファイルフルパス(テキストファイル)を開く
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   Set ファイル = ファイルシステムオブジェクト.OpenTextFile(入力ファイルフルパス, 1, False)
   テキスト = ファイル.ReadAll
   ファイル.Close

   開始行 = 1
   文字列配列 = Split(テキスト, VbCrLf)
   
   'トップ行を、タイトルと見なす
   タイトル = Trim(文字列配列(0))                                                          ?
   If Left(タイトル, 1) = "." Then
      タイトル = Trim(Right(タイトル, Len(タイトル) - 1))                                 ?
   End If
   
   '全体行数を取得
   全体行数 = UBound(文字列配列)                                                           ?
   
   追番 = 1
   
   For 開始行 = 1 To 全体行数
      出力ファイル名 = 現在のパス & 入力ファイル名拡張子無し & 追番 & タイトル & ".txt"   ?
      
      Call ファイル出力(出力ファイル名, 開始行)
      
      追番 = 追番 + 1
   Next

    Set ファイルシステムオブジェクト = Nothing
    
    終了日時 = Now
   MsgBox "処理を終了しました。" & vbNewLine _
      & "処理時間は、" & FormatDateTime(終了日時 - 開始日時) & " でした。"

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

IEで表示中のURLの一階層上を表示

 下記のサイトで、「IE7/IE8で、現在または最後にアクティブなIEを捕捉する」スクリプトを紹介していただいているのを見つけました。
http://app.m-cocolog.jp/t/typecast/221427/189040/59273927
 このスクリプトを利用して、IEで現在表示しているURLの、一階層上のURLを開くスクリプトを作ってみました。

 ウィンドウの操作 一覧表示★
http://www.winapi-database.com/Window/Change/
 参考:Windows Scripting Host 23
http://homepage3.nifty.com/aya_js/wsh/wsh23.htm
 参考:最前面表示
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1217957967
 参考:ウィンドウハンドル番号を取得する
http://www.happy2-island.com/excelsmile/smile04/capter00302.shtml
 参考:VB テクニック編2 - Windows API、ウィンドウハンドル取得、ウィンドウ制御
http://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_t02.htm

■用途:
IE で表示しているホームページの、1階層上位の画面を、別画面で開く。

■使い方
IE でホームページを表示していて、その上位の画面を見たいときに、ホットキー操作します。


'	IEで表示中のURLの一階層上を表示
Option Explicit
Dim バージョン

Call IEバージョン(バージョン)

If バージョン > 6 Then
  '**********************************************************************
  '  IE7/IE8で、現在または最後にアクティブなIEを捕捉
  'Windows Script Programming
  'http://app.m-cocolog.jp/t/typecast/221427/189040/59273927
  '------------------------------------------------------------------
  'Win32APIのFindWindow()を併用すれば、正確に捕捉できます。

  Dim ウインドウハンドル
  Dim IE
  Dim 現在のURL
  Dim 表示するURL

'Excel の関数を使った版
  ウインドウハンドル = CreateObject("Excel.Application").ExecuteExcel4Macro("CALL(""user32"",""FindWindowA"",""JCJ"",""IEFrame"",0)")

'SFC mini版 *******ここから******************
'Excel をインストールしていないパソコンの場合は、下 URL の「SFC mini」をインストールして、
'以下のソース部分6行のコメントを外して、上のExcel版の一行のコードを、コメント・アウトします。
'http://kandk.cafe.coocan.jp/sfcmini/

'参考にさせていただいたサイト「タスクバーを透明化するVBScript」
'http://d.hatena.ne.jp/Shinez/20100121

'  Dim FindWindow
'  Set FindWindow = CreateObject("SfcMini.DynaCall")
'  FindWindow.Declare "user32", "FindWindowA"

'  Do Until ウインドウハンドル <> 0
'    ウインドウハンドル = FindWindow("IEFrame")
'  Loop
'SFC mini版 *******ここまで******************


  For Each IE In CreateObject("Shell.Application").Windows()
    If ウインドウハンドル = IE.HWND Then
      IE.StatusText = CStr(ウインドウハンドル)
  '    MsgBox IE.StatusText
      If IE.StatusText = CStr(ウインドウハンドル) Then Exit For
    End If
  Next
  If IsEmpty(IE) Then
    MsgBox "IE6には対応していません。" & vbNewLine & "または、Not Found"
  Else
    現在のURL = IE.LocationURL ?
  '  MsgBox IE.LocationURL
  End If
  'アクティブなIEウィンドウはFindWindow("IEFrame",0)で分かりますが、アクティブなタブは分かりません。
  'しかし、StatusTextが変更可能なのはアクティブなタブだけなようなので、それで区別できます。
  '**********************************************************************

Else
  '**********************************************************************
  '  アクティブなIE6のURLを取得
  'http://d.hatena.ne.jp/md2tak/20090822/p1
  Dim Shell, window, activeWin

  Set Shell = CreateObject("Shell.Application")
  Set activeWin = Shell.Windows.Item
  
'  MsgBox activeWin.document.url
  現在のURL = activeWin.document.url ?

  Set activeWin = Nothing
  Set Shell = Nothing
  '**********************************************************************
End If

  表示するURL = 一階層上のURL(現在のURL) 
  Call IEを起動(表示するURL)


  '**********************************************************************
Function 一階層上のURL(URL) 
  'URLから/以下を削除する
  Dim スキーム区分頭桁
  Dim スキーム区分後続桁

  スキーム区分頭桁 = InStr(URL, "://")
  スキーム区分後続桁 = InStrRev(URL, "://")
  
  If InStr(URL, "file://") > 0 Then
    MsgBox "このURLは、ハードディスクのデータで、対象外です。"
    HotVBS.Quit
  End If

  If Right(URL, 1) = "/" Then
    URL = Left(URL, Len(URL) - 1)
  ElseIf Right(URL, 11) = "/index.html" Then
    URL = Left(URL, Len(URL) - 11)
  ElseIf Right(URL, 10) = "/index.htm" Then
    URL = Left(URL, Len(URL) - 10)
  End If

  If スキーム区分頭桁 = InStrRev(URL, "/") - 2 Then
    MsgBox "このURLは、最上位です。"
    HotVBS.Quit
  ElseIf スキーム区分頭桁 <> スキーム区分後続桁 _
    And スキーム区分後続桁 = InStrRev(URL, "/") - 2 Then
    一階層上のURL = Left(URL, スキーム区分後続桁 - 6) ?
  Else
    一階層上のURL = Left(URL, InStrRev(URL, "/") )    ?    
  End If

'  MsgBox URL
'  MsgBox 一階層上のURL
End Function
  '**********************************************************************

  '**********************************************************************
'  InternetExplorer を起動する
'http://www.whitire.com/vbs/tips0154.html
Sub IEを起動(表示するURL)
  Dim IEオブジェクト

  Set IEオブジェクト = WScript.CreateObject("InternetExplorer.Application")
  If Err.Number = 0 Then
      IEオブジェクト.Navigate 表示するURL
      IEオブジェクト.Visible = True
  Else
      WScript.Echo "エラー:" & Err.Description
  End If
  Set IEオブジェクト = Nothing
End Sub
  '**********************************************************************

  '**********************************************************************
'  インストールされている Internet Explorer のバージョンを調べる
Sub IEバージョン(バージョン)
  Dim IEバージョン 'As String
  Dim ファイルシステムオブジェクト 'As Object
  
  Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

  IEバージョン = ファイルシステムオブジェクト.GetFileVersion _
  ("C:\Program Files\Internet Explorer\IEXPLORE.EXE ")
'  MsgBox IEバージョン
  
  バージョン = CInt(Left(IEバージョン, InStr(IEバージョン, ".") - 1))  ?
    
  Set ファイルシステムオブジェクト = Nothing
End Sub
  '**********************************************************************

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

ノーツ・メイル転送して削除(クリップボード)

■ 目的
特定のノーツ・メイルを、特定の送付先に転送して、削除する。

■ 使い方
ノーツを開いて、必ず★IMEは、英数の状態★にした上で、実行します。
対象のメイルを開いて、ホットキー操作する。

■ 経歴
2011/03/29:作成

■ 解説
IME のオン/オフを、VBSでうまくコントロールできないので、
HotVBS のクリップボード機能を使って、本文を入力する。
メルアド部分は、ノーツで特別な動きをして、クリップボードが使えないので、
メルアド部分は、SendKeys を使う。

■ 参考にさせていただいたサイト
http://www.atmarkit.co.jp/fwin2k/operation/wsh05/wsh05_04.html
http://www.officetanaka.net/excel/vba/tips/tips16.htm
http://d.hatena.ne.jp/hogege/20080422/1208833874


Option Explicit
Dim WshShell
Dim i
Dim YesNo

Set WshShell = CreateObject("WScript.Shell")

HotVBS.Sleep(500)
WshShell.AppActivate "Arrival mail"

HotVBS.Sleep(1000) 'SendKeys の前に、適度な待ちを入れないと、誤動作します。
WshShell.SendKeys "%4o", True 'メイル転送ボタンを押す

HotVBS.Sleep(250)

Do Until WshShell.AppActivate("新規メール")
   HotVBS.Sleep(100)
Loop

WshShell.SendKeys "taro nishiura/company@company", True '宛てのメルアド設定
HotVBS.Sleep(250)

WshShell.SendKeys "{TAB}", True 'cc の欄に移動

HotVBS.Sleep(250)
WshShell.SendKeys "jiro okaya/company@company", True  'cc のメルアド設定

HotVBS.Sleep(250)
For i = 1 To 3   
   WshShell.SendKeys "{TAB}", True '本文欄に移動
Next

HotVBS.Sleep(250)

ClipBoard.Clear                           'クリップボードをクリア
ClipBoard.Text = "データチェック下さい。" 'クリップボードへ文字列設定
Editor.Past                               'クリップボードからエディタへ貼付け
HotVBS.Sleep(250) 'Editor.Past の後ろに、適度な待ちを入れないと、誤動作します。
ClipBoard.Undo
HotVBS.Sleep(1000) 'SendKeys の前に、適度な待ちを入れないと、誤動作します。

WshShell.SendKeys "{ENTER}", True '本文の最後に空白行を入れる
   
HotVBS.Sleep(250)

YesNo = MsgBox ("送信して良いですか?", 33, "誤送信防止のため、一旦止める") ?

If YesNo = vbCancel Then 'いいえ
   Hotvbs.Quit
End If


WshShell.SendKeys "%1", True '送信ボタンを押す

Do Until WshShell.AppActivate("Arrival mail")
   HotVBS.Sleep(100)
Loop

HotVBS.Sleep(250)
WshShell.SendKeys "%5", True '元の受信メイルを、削除する

この種類の目次に戻る↑ 索引へ↓ プログラム開発関連に戻る

索引

用語内容事例
文字列の定数文字コードを表す定数は、あらかじめ VBScript に組み込まれています。行末空白削除して連続空行を1行に
AppActivate メソッドアプリケーション ウィンドウをアクティブにします。計算を実行
Array 関数配列が格納されたバリアント型 (Variant) の値を返します。WScriptをHotVBSに
CreateObject 関数オートメーション オブジェクトへの参照を作成して返します。カナ→ローマ字変換
Dim ステートメント変数を宣言してメモリ領域を割り当てます。ファイルを行ソート
FileDialogオブジェクトHotVBS の専用オブジェクトで、ファイルダイアログのユーザーインターフェースです。ファイルを行ソート
FileSystemObject (FSO) ドライブ、ファイルおよびフォルダの操作を行うことができます。テキストを「なでしこ」で実行
FormatDateTime 関数日付形式または時刻形式の文字列に書式設定して返す文字列処理関数です。ファイルを行ソート
GetObject 関数ファイルから取得したオートメーション オブジェクトへの参照を返します。カナ→ローマ字変換
InputBox 関数ダイアログ ボックスにメッセージとテキスト ボックスを表示し、テキストが入力されるか、またはボタンがクリックされると、テキスト ボックスの内容を返します。計算を実行
MsgBox 関数ダイアログ ボックスにメッセージを表示し、ボタンがクリックされるのを待って、どのボタンがクリックされたかを示す値を返します。ファイルを行ソート
OpenTextFile メソッド指定したファイルを開き、開いたファイルの読み取り、または追加書き込みに使用できる TextStream オブジェクトを返します。ソースコード整形
Rnd 関数乱数を返します。計算を実行
Regular Expression オブジェクト簡単な正規表現をサポートします。WScriptをHotVBSに
Replace 関数指定された文字列の一部を、別の文字列で指定された回数分で置換した文字列を返します。WScriptをHotVBSに
Split 関数各要素ごとに区切られた文字列からゼロ ベースの 1 次元配列を作成し、返します。行末空白削除して連続空行を1行に
StrComp 関数文字列比較の結果を表す値を返します。ファイルを行ソート
TextStream オブジェクトファイルへのシーケンシャル アクセスを行うオブジェクトです。テキストを「なでしこ」で実行
Trim、LTrim、RTrim 関数指定された文字列から、スペースを削除した文字列を返します。行末空白削除して連続空行を1行に
UBound 関数配列で指定した次元で使用できるインデックス番号の最大値を返します。WScriptをHotVBSに
WriteLine メソッドWriteLine メソッドは、指定した文字列と改行文字を TextStream ファイルに書き込みます。テキストを「なでしこ」で実行
WshShell オブジェクトプログラム実行などに使います。DDwinで辞書引き
文字コードを表す定数文字コードを表す定数行末空白削除して連続空行を1行に

←リンク元に戻る この種類の目次に戻る↑ プログラム開発関連に戻る



ホームページのトップに戻る