変奏現実

パソコンやMMORPGのことなどを思いつくまま・・・記載されている会社名・製品名・システム名などは、各社の商標、または登録商標です。

この画面は、簡易表示です

インターネット

[ActiveX]JavascriptのActiveXの代案 ※検討中

Windows11でIEが消えていたので、IE用のJavaScriptでActiveXを使ってブラウザでMDBの中身を見るツールが使えない。

そこで、C#でローカルWEB(+REST)サーバEXEを作り、ActiveXをEXEで処理してブラウザは非同期通信でリモートでコントロールさせてみたい。

IE用のindex.htmlとJSファイルはEXEのwwwrootフォルダに入れておき

C#のMainから8000ポートを開き、GETコマンドリクエストがあれば、exeファイルのトコのwwwrootフォルダのファイルを返す様にしておく。

参考文献:簡易Webサーバを実装するには?[2.0のみ、C#、VB]

using System;
using System.IO;
using System.Net;

namespace LocalWebServer
{
class WebFileServer
{
  static void Main()
  {
    string root = @"wwwroot\"; // ドキュメント・ルートは好きな場所でOK
    string prefix = "http://localhost:8000/"; // URLはしっかり書かないとエラる
    // ブラウザでindex.htmlを開く。ココからjsファイルもGETされるハズ
    System.Diagnostics.Process.Start(prefix + "index.html");
  //
    HttpListener listener = new HttpListener();
    listener.Prefixes.Add(prefix); // プレフィックスの登録
    listener.Start();
    while (true) {
      HttpListenerContext context = listener.GetContext();
      HttpListenerRequest req = context.Request;
      HttpListenerResponse res = context.Response;
      Console.WriteLine(req.RawUrl);
      // リクエストされたURLからファイルのパスを求める
      string path = root + req.RawUrl.Replace("/", "\\");
      // ファイルがあれば出力
      if (File.Exists(path)) {
        byte[] content = File.ReadAllBytes(path);
        res.OutputStream.Write(content, 0, content.Length);
      } else {
         // TODO エラー処理 404 あるいはREST処理をしないといけないかもしれない
      }
      res.Close();
    }
  }
}
}

とRESTのWEBサービスっぽく

HTMLファイルは、

<script src="./ActiveX.js">
・・・
<script src="./${他のjsファイル}">

と付け加え、JavaScript上のActiveX(“xxxxx”)の実装を差替える。

ActiveX(objectID) => {
  let promise = new Promise( (resolve, reject) => {
    let domain = "localhost";
    let port = 8000;
    let xhr = new XMLHttpRequest();
    xhr.open('GET', `http://${domain}:${port}/ActiveX/`, true);
    xhr.responseType = 'json';
    xhr.send(null);
    xhr.onload = function(e) {
      if (xhr.readyState == 4) {
        if (xhr.status == 200 ) {
          resolve(JSON.parse(xhr.response));
        }
      }
    };
  });
  return promise;
};

ActiveXの予備元やそのメソッドの呼び出しは全てawaitを追記

async function  xxxx(...)
{
  let obj = await ActiveX("xxxxx");
}

プロパティ呼び出しはC#側でデータを展開しておいた方が良さそう

しかし、メソッドもプロパティもいっぱいあるので

class  ADODB_xxxxxx
    constractor()
    {
        this.className = "ADODB.xxxxxx";
        dummy_properties();
        dummy_methods();
    }
    dummy_properties()
    {
      let properties = ['BOF','EOF',....,'fields'];
      properties.foreach( (p) => {
          this[p] = new Function (`
            set ${p}(v) {
               alert('set ${p} no support.');
            }
            get ${p}() {
               alert('get ${p} no support.');
            }
          `);
      });
    }
    dummy_methods()
    {
      let methods = ['BOF','EOF',....,'fields'];
      methods.foreach( (m) => {
          this[m] = new Function (`
               alert('set ${m} no support.');            
          `);
      });
    }

で、TODO風に作っておいて、後で実装を考えた方が良さそう。

あるいは、各ActiveX用のクラスJSファイルは、ワーカースレッドよろしく

var adodbWorkers = [];
・・・
adodbWorkers["ADODB.xxxxxx"] = new Worker('ADODB.xxxxxx.js');

とやって

adodbWorkers["ADODB.xxxxxx"].postMessage(${メソッド名},${パラメータ1},...,${パラメータn});

onmessage = function(e) {
 switch(e)
 {
   case "BOF":
    どうしよう
     break;
    ・・・
 }
}

adodbWorkers["ADODB.xxxxxx"].onmessage = function(e) {
  何とかかんとか  
 resolve(e,data)とか
}

して、がら空きの実装で使うとこだけ実装する方式で済ませるのがいいかもしれない。



[Oracle12c]コンテナ・データベース

最近のOracleのデータベースのインスタンスを作成する時に「コンテナ・データベース(CDB)として作成する」ができる様だ。

今までのデータベース(区別するためにプラガブル・データベース(PDB)と名前が付いている)を複数個格納できるコンテナなデータベースらしい。

各データベース(CDB,PDB)の接続方法は

  • 新たなコンテナ・データベース(CDB)はローカル接続のみ。
  • 今までのデータベース(PDB)はリモート接続のみに変わる。

ということで、一般ユーザ(アプリを含む)からは、何も変わらない気がするけどね。

ただ、安易にCDBを作成するとPDBの接頭語を指定してpdb1,pdb2,pdb3とか名前が自動的に割り振られてしまうようなので、リモート接続のインスタンス(あるいはサービス名?)は変更しないといけなさそう。

そんな訳で、コンテナDBの管理者に

  • CDBにローカル接続
  • CDBで共通ユーザを作って、ログ収集用とか最適化用とかIMPORT/EXPORT用とかロールを割当る。
    • 共通ユーザ名は「C##またはc##」の接頭語が必要らしい。
  • ALTER SESSION SET CONTAINER = ${PDBの名前}; でPDBを指定して、
  • 各PDBの管理者や一般ユーザのアカウントの登録とロールを設定する。

をしてもらえば、後は概ね今まで通りで良いんじゃないのかな?

各PDBのテーブル登録は各PDBの管理者がリモートできるから便利になるかもかも

後、データベース・サーバの移行は・・・

移行元サーバのデータベースがCDBなら、

  1. 移行先サーバで空のCDBを作成
  2. SQL Developerの接続先に移行先・元サーバを追加
  3. SQL Developerで移行元サーバの移行したいPDBで
    1. 「状態の変更」
    2. 「プラガブル・データベースの切断」
  4. 移行したいPDBをフォルダ毎、移行先サーバへコピー(これが難物)
  5. SQL Developerで移行先サーバで
  6. CDBで「プラガブル・データベースのプラグイン」
    1. アンプラグした時に生成したXMLファイルをPDB名を指定

となるらしい。

EXPORT/IMPORTの方が手順が短いけど、IMPORTで難解なエラーに悩むかもしれない事を考えると、楽そうではある。

最もDBが巨大なファイル(100GBとか)になっていたら、rsyncするか、DB移行アプリでも作って一週間も動かし続けるとかかもしれないけどね。

参考文献1:ユージ&ギョータの実践データベース講座

参考文献2:rsync専用の秘密鍵を使ってサーバ間でrsyncする



[三国英雄の夜明け]これからどうなるんだろう?

魂玉を7品質にレベルアップするため、全戦力は1600万台に下がってます。

上位キャラ強化 < 下位キャラ弱体化

そんな中、ランク表でナンバー1のキャラが休止に入ったらしい。

ボクより下の方に下がっていたから、探し出すのが大変だった。

どうやら、装備一式や副将を外してる様だ。

とりあえず、ゲームのマップ上は大混戦になっている。

そして今、一番気になるのは!

演武大会で誰にオッズすればいいんだ?

ps.

悩んでいるうちに投票時刻はとっくに過ぎていました。(メデタシメデタシ



【コンピュータのドキュメントとかコードとか】の粒度

フローチャートは砂粒の様な粒度で書けばいいのかもしれないけど、アルゴリズムやワークフレームは大雑把に書いて概要やメソッドのシーケンス(動き)を把握できる方がいい。

面倒なのがワークフローで、UIのテストにも流用できるようとついつい砂粒の様な粒度で書いてしまい、全体がどうなっているのかサッパリ判らなくなり、コードする時に外部(staticっぽい)変数の初期化のタイミングがブレブレで、UIの操作の順(画面1→画面2→画面3とか,画面1→画面3→画面2だったり)で、初期表示で設定する内容がグダグダになりやすい。GUIな画面のテストで操作の順でグダグダになるケースをリストアップするなんて、最悪だ。

例えば、画面1~9へ遷移するボタンがあるメニュー画面を考えてみよう。

このメニュー画面はどういう訳か、ボタンの押す順序でボタンnに対応する画面nの初期状態がバグってしまう事があります。一通り操作して、どんな順序でボタンを押すとバグるのか調べてみましょう。

画面1画面2画面3
画面4画面5画面6
画面7画面8画面9
こんな画面の操作の組合せは何通り?

ここでの「何通り」は、数学で云うところの順列になるので

P9=(9!)÷(0!)=9!=362,880通り

画面を操作してバグのケースを探し出すのは徹夜しても無理っぽく思える。

しかし、これも【ボタン】と云うコントロールを使用している場合であって

画面の座標から画面nを決定するコードをガリガリ書いていたら、画面の全ドットをクリックするテストケースになってしまうので、まだマシ。

今から40年くらい前にロクなライブラリィが無いのにCUIからGUIへ移行した時期のテストは、

「人数をかき集め好き勝手に画面をマウスで叩かせる」≒100人で実施した≒多分大丈夫

の様なMMORPGのαテスト的なシロモノで、テストケースを見積もると桁違いの数になり「テストケースの見積りを諦めていた」のは「今だから云える」話である。

(閑話休題)

さすがに40年も経つと一部の人は経験を積み、

画面nの中で、外部(staticっぽい)変数を書き換える箇所を無くし、テストケースを日常的な業務量ぐらいに削減でき、テストケースの粒度(?)を

メニューの操作、【画面1】の操作、・・・、【画面9】の操作

と大まかに9通りに縮小できる。(それでも中身は相当な数かもしれない

これがうまくいかないと362,880通りの「ボタンを押すダケ」のテストケースがスポーンするので、とても有用である。

また各画面でも、粗相が無い様にコードしないと、地獄を見ることは云うまでもない。

え?そんなの有り得ない?変数のスコープのブロック化や変数をまとめたクラス化や例外処理のTry~Catch~Finallyで解決済み?

だがその常識は40年くらい前から少しづつ確立していったもので未だ未完成である。

Tryブロックをスコープとする変数をCatchやFinallyで参照できないため、Tryブロックの外に変数を配置しなおす(例外処理のスコープの外へ押し出す)ハメになったことは無いかな?

SqlConnection connection= new SqlConnection(DBConnectionString);
try {
    // データベースコネクションを開く
    connection.Open();
    SqlTransaction transaction= connection.BeginTransaction(IsolationLevel.Serializable);
    try {
        // データベースを色々操作してみる
        SqlCommand command1 = connection.CreateCommand();
        command1.CommandText = "SELECT * FROM table001 ORDER BY CategoryID";
        command1.CommandTimeout = 15;
        command1.CommandType = CommandType.Text;
        command1.ExecuteReader();
        ・・・
        SqlCommand command2 = new SqlCommand("INSERT INTO table001(CategoryID) values '001'", transaction.Connection);
        command2.Connection.Open();
        command2.ExecuteNonQuery()
        ・・・
        // 操作を終えたので、データベーストランザクションをコミットする
        transaction.Commit();
    } catch (Exception ex) {
        // 失敗したらしいので、データベーストランザクションを巻き戻す
        transaction.Rollback();
        // 失敗したことを通知
        throw ex;
    } finally {
        transaction.dispose();
    }
} catch (Exception ex) {
    // 失敗したことを通知
    throw ex;
} finally {
    connection.dispose();
}

C#やVBのusingステートメントは自動的にdisposeし変数を始末してくれるので変数を外に出すことは無くなるが、変数がデータベースのトランザクション・オブジェクトの様にシーケンスな手順がある場合にはusingステートメントの中で try~catchを使い適切なシーケンスを維持するべきだろう。

using (SqlConnection connection= new SqlConnection(DBConnectionString)) {
    // データベースコネクションを開く
    connection.Open();
    using (SqlTransaction transaction= connection.BeginTransaction(IsolationLevel.Serializable)) {
        try {
            // データベースを色々操作してみる
            SqlCommand command1 = connection.CreateCommand();
            command1.CommandText = "SELECT * FROM table001 ORDER BY CategoryID";
            command1.CommandTimeout = 15;
            command1.CommandType = CommandType.Text;
            command1.ExecuteReader();
            ・・・
            SqlCommand command2 = new SqlCommand("INSERT INTO table001(CategoryID) values '001'", transaction.Connection);
            command2.Connection.Open();
            command2.ExecuteNonQuery()
            ・・・
            // 操作を終えたので、データベーストランザクションをコミットする
            transaction.Commit();
        } catch (Exception ex) {
            // 失敗したらしいので、データベーストランザクションを巻き戻す
            transaction.Rollback();
            // 失敗したことを通知
            throw ex;
        }
    }
}

transactionがusingステートメントに入り見た目も綺麗なコードになり、transaction.dispose()もthrow exも書かずに済むので大助かり。つまり、usingステートメントとtry~catchは補完関係にある。

しかし、処理の粒度は変わらないから、ちょっと短くなりパッとみ綺麗になっただけ。



【Microsoft365用】Excelのマクロや計算式を除外して保存する方法

【Excel】マクロや計算式を除外して保存する方法 のソースでは、

今のMicrosoft365のExcelでの動作が不安定だったので見直したものです。

Option Explicit

Public Sub アクティブなブックのセル値を値に変換して保存()
On Error GoTo err1
    Call 非表示のワークシートを削除する(ActiveWorkbook)
    Call ワークシートのセル値を値に変換して保存(ActiveWorkbook)
    Call 普通のEXCELファイルに保存(ActiveWorkbook)
exit1:
    Exit Sub
err1:
    MsgBox Err.Description
    GoTo exit1
End Sub

Private Sub 非表示のワークシートを削除する(ByRef ワークブック As Excel.Workbook)
    Dim ワークシート As Excel.Worksheet
    For Each ワークシート In ワークブック.Worksheets
      If ワークシート.Visible <> Excel.XlSheetVisibility.xlSheetVisible Then
        '確認メッセージを非表示にする設定
        Excel.Application.DisplayAlerts = False
        '非表示のワークシートを削除
        ワークシート.Delete
        '確認メッセージを表示する設定
        Excel.Application.DisplayAlerts = True
      End If
    Next
End Sub

Private Sub ワークシートのセル値を値に変換して保存(ByRef ワークブック As Excel.Workbook)
    '全シート選択
    '条件:事前に非表示なワークシートは削除済みであること
    '非表示なワークシートが残っている場合は ワークブック.Sheets(Array("Sheet1", "Sheet2")).Selectな感じで表示ワークシートに限定して選択すること )
    ワークブック.Sheets.Select
    '全ワークシートを選択
    ワークブック.Application.Cells.Select
    '全ワークシートをコピー
    ワークブック.Application.Selection.Copy
    '全ワークシートへ値としてペースト
    ワークブック.Application.Selection.PasteSpecial Paste:=xlPasteValues, _
      Operation:=xlNone, _
      SkipBlanks:=False, _
      Transpose:=False
    'コピペモードの解除
    ワークブック.Application.CutCopyMode = False
    'シート全体を選択したままになっているので、
    'A1のみ選択の状態にする
    Call ワークブック.Application.Cells(1, 1).Select
End Sub

Private Sub 普通のEXCELファイルに保存(ByRef ワークブック As Excel.Workbook)
    Dim ファイル名 As String
    '拡張子を削除 ※削除しないと拡張子が重複する
    ファイル名 = Replace(ワークブック.FullName, ".xlsm", "")
    '確認メッセージを非表示
    ワークブック.Application.DisplayAlerts = False
    '普通のExcelファイルに保存
    ワークブック.SaveAs Filename:=ファイル名, _
      FileFormat:=xlOpenXMLWorkbook, _
      Password:="", _
      WriteResPassword:="", _
      ReadOnlyRecommended:=False, _
      CreateBackup:=False
    '確認メッセージを表示
    Application.DisplayAlerts = True
    '処理完了メッセージ
    MsgBox ファイル名 & ".xlsx" & vbCrLf & "に名前を変えて保存しました"    
End Sub

事前に非表示のシートを削除することで全シート選択の仕方が簡素になってます。非表示シートをそのまま保存したい場合は前の記事を参考にしてください。

Microsoft365のExcelで動作が変だったのは「普通のEXCELを保存」です。

  1. SaveAsのFilenameには拡張子を除くフルパスなファイル名を指定するように変えました。
    • 確認メッセージを非表示にすると、
    • 「chdir パス名」で保存先フォルダを変更する方法が失敗しやすい。
  2. ReadOnlyRecommendedパラメータの名前を訂正
    • 記事にソースをペーストした際に綴りがおかしくなっていたので訂正。
    • ここは旧版でも動かないハズです。

結果的にソースが短くなったのでOKかな。(笑



[Excel VBA]WORD文書のコメントの頁番号を列挙する

今度はWORD文書のコメントの頁番号を列挙するマクロです。

EXCELのワークシートの「コメント行」セル名に「コメント」「コメント対象」「コメント頁番号」の列を追加して使用します。

コメントをワークシートに転記するマクロの内容は赤字頁番号()をコピってこんな感じに

Public Sub コメント字頁番号検索()
On Error GoTo err1
    '初期化
    Dim wordApp As Word.Application
    Set wordApp = CreateObject("Word.Application")
    Dim コメントの開始行 As Long
    コメントの開始行 = ActiveSheet.Range("タイトル行").row + 1
    Dim コメントの列 As Long
    コメントの列 = ActiveSheet.Range("タイトル行").Find("コメント").Column
    Dim コメント対象の列 As Long
    コメント対象の列 = ActiveSheet.Range("タイトル行").Find("コメント対象").Column    
    Dim 頁番号の列 As Long
    On Error Resume Next
    Err.Clear
    頁番号の列 = ActiveSheet.Range("タイトル行").Find("コメント頁番号").Column
    If Err.Number <> 0 Then
        頁番号の列 = ActiveSheet.Range("タイトル行").Find("頁番号").Column
    End If
    '検索対象のWORD文書を開く
    Dim wordFname As String
    wordFname = 検索対象のWORD文書名を調べる
    Dim wordDoc As Word.document
    Set wordDoc = 検索対象のWORD文書を開く(wordApp, wordFname)
    If TypeName(wordDoc) <> "Nothing" Then
        Dim row As Long
        row = コメントの開始行
        wordDoc.ActiveWindow.Selection.Start = 0
        wordDoc.ActiveWindow.Selection.End = 0
        Dim コメント As Word.Comment
        Dim 順番 As Integer
        順番 = 1
        Do While (コメント検索(wordDoc, 順番, コメント))
            Dim コメント対象テキスト As String
            コメント対象テキスト = コメント.Range.text
            コメント対象テキスト = Replace(コメント対象テキスト, vbCr, "")
            コメント対象テキスト = Replace(コメント対象テキスト, vbLf, "")
            コメント対象テキスト = Trim(コメント対象テキスト)
            If コメント対象テキスト <> "" Then
                'コメント
                ActiveSheet.Cells(row, コメントの列).Value = コメント.Range.text
                'コメントの対象テキスト
                コメント.Scope.Copy
                ActiveSheet.Cells(row, コメント対象の列).Select
                ActiveSheet.Paste
                Dim pasteRows As Integer
                pasteRows = Selection.Count
                Dim st, ed
                st = コメント.Scope.Start
                ed = コメント.Scope.End
                Dim 開始頁番号 As Integer
                wordDoc.ActiveWindow.Selection.Start = st
                wordDoc.ActiveWindow.Selection.End = st
                開始頁番号 = wordDoc.ActiveWindow.Selection.Information(wdActiveEndAdjustedPageNumber)
                Dim 終了頁番号 As Integer
                wordDoc.ActiveWindow.Selection.Start = ed
                wordDoc.ActiveWindow.Selection.End = ed
                終了頁番号 = wordDoc.ActiveWindow.Selection.Information(wdActiveEndAdjustedPageNumber)
                '右セルに頁番号を書き込む
                Dim 頁番号説明文 As String
                If 開始頁番号 <> 終了頁番号 Then
                    ActiveSheet.Cells(row, 頁番号の列).Value = 開始頁番号 & "~" & 終了頁番号 & "頁"
                Else
                    ActiveSheet.Cells(row, 頁番号の列).Value = 開始頁番号 & "頁"
                End If
                row = row + pasteRows
            End If
        Loop
    End If
exit1:
    Call MSWORDをそのまま閉じる(wordApp)
    Exit Sub
err1:
    MsgBox Err.Description
    GoTo exit1
End Sub

コメント検索は、順序の順にコメントを引き渡し、無くなったらFalseを返す様にしました。

パラメータのByRef指定を使って順序とコメントの内容を更新する方法は余り使わなくなった手法かもしれません。

Private Function コメント検索(ByRef wordDoc As Word.document, ByRef 順番 As Integer, ByRef コメント As Word.Comment) As Boolean
    With wordDoc.Comments
        If 順番 > .Count Then
            コメント検索 = False
            Exit Function
        End If
        Set コメント = wordDoc.Comments(順番)
        順番 = 順番 + 1
    End With
    コメント検索 = True
End Function

実際には、コメント検索やワークシートに【返信(Replies)】と【解決(Done)】の処理があった方が使い道がありそうですけどね。



[Excel VBA]WORD文書の赤色属性を含む文字の頁番号を列挙する

先の[Excel VBA]WORD文書の赤字の頁番号を列挙するでは、赤字以外の属性(抹消線など)があるテキストをヒットしなかったので、改訂版です。

今回はWORDの「高度な検索」の「書式」で「赤字」だけ設定する方法を使います。

と云っても、赤文字頁番号検索()少し変えたダケです。(笑

Public Sub 赤文字頁番号検索()
On Error GoTo err1
    '初期化
    Dim wordApp As Word.Application
    Set wordApp = CreateObject("Word.Application")
    Dim 赤字の開始行 As Long
    赤字の開始行 = ActiveSheet.Range("タイトル行").row + 1
    Dim 赤字の列 As Long
    赤字の列 = ActiveSheet.Range("タイトル行").Find("赤字").Column
    Dim 頁番号の列 As Long
    On Error Resume Next
    Err.Clear
    頁番号の列 = ActiveSheet.Range("タイトル行").Find("赤字頁番号").Column
    If Err.Number <> 0 Then
        頁番号の列 = ActiveSheet.Range("タイトル行").Find("頁番号").Column
    End If
    '検索対象のWORD文書を開く
    Dim wordFname As String
    wordFname = 検索対象のWORD文書名を調べる
    Dim wordDoc As Word.document
    Set wordDoc = 検索対象のWORD文書を開く(wordApp, wordFname)
    If TypeName(wordDoc) <> "Nothing" Then
        Dim row As Long
        row = 赤字の開始行
        wordDoc.ActiveWindow.Selection.Start = 0
        wordDoc.ActiveWindow.Selection.End = 0
        Do While (高度な赤字検索(wordDoc))
            Dim 赤字 As String
            赤字 = wordDoc.ActiveWindow.Selection.text
            赤字 = Replace(赤字, vbCr, "")
            赤字 = Replace(赤字, vbLf, "")
            赤字 = Trim(赤字)
            If 赤字 <> "" Then
                wordDoc.ActiveWindow.Selection.Copy
                ActiveSheet.Cells(row, 赤字の列).Select
                ActiveSheet.Paste
                Dim pasteRows As Integer
                pasteRows = Selection.Count
                Dim st, ed
                st = wordDoc.ActiveWindow.Selection.Start
                ed = wordDoc.ActiveWindow.Selection.End
                Dim 開始頁番号 As Integer
                wordDoc.ActiveWindow.Selection.Start = st
                wordDoc.ActiveWindow.Selection.End = st
                開始頁番号 = wordDoc.ActiveWindow.Selection.Information(wdActiveEndAdjustedPageNumber)
                Dim 終了頁番号 As Integer
                wordDoc.ActiveWindow.Selection.Start = ed
                wordDoc.ActiveWindow.Selection.End = ed
                終了頁番号 = wordDoc.ActiveWindow.Selection.Information(wdActiveEndAdjustedPageNumber)
                '右セルに頁番号を書き込む
                Dim 頁番号説明文 As String
                If 開始頁番号 <> 終了頁番号 Then
                    ActiveSheet.Cells(row, 頁番号の列).Value = 開始頁番号 & "~" & 終了頁番号 & "頁"
                Else
                    ActiveSheet.Cells(row, 頁番号の列).Value = 開始頁番号 & "頁"
                End If
                row = row + pasteRows
            End If
        Loop
    End If
exit1:
    Call MSWORDをそのまま閉じる(wordApp)
    Exit Sub
err1:
    MsgBox Err.Description
    GoTo exit1
End Sub

後は、高度な赤字検索()を追加するだけです。

中身はWORDで「高度な検索」の「書式」で「赤字」だけ設定した時のマクロ記録内容を少し調整したものです。

Private Function 高度な赤字検索(wordDoc As Word.document) As Boolean

    With wordDoc.ActiveWindow.Selection.Find
        '書式関連を初期化
        .ClearFormatting
        .Font.Color = wdColorRed
        '文字関連を初期化
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindStop '文書の終わりで中断
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
        '検索
        .Execute
        '結果を取得
        高度な赤字検索 = .Found
    End With

End Function

検索対象のWORD文書名を調べる検索対象のWORD文書を開くMSWORDをそのまま閉じるは前の記事のままです。

Font.ColorとFont.ColorIndexのいづれを使うのか良いのかは悩ましいです。

後、デバッグ中は起動したMS-WORDをタスクマネージャから終了していましたが、上記のwordAppを外部変数にして、マクロ画面から終了させた方が便利そう。

Dim wordApp As Word.Application
・・・
Set wordApp = CreateObject("Word.Application")
・・・
public sub マクロ実行中に起動したMSWORDを強制終了
    Call MSWORDをそのまま閉じる(wordApp)
End Sub 


[Excel VBA]WORD文書の赤字の頁番号を列挙する「赤字以外の属性不可」

WORD文書の中の赤字を見つけるマクロを見つけた。

添削するには便利、しかしそんな便利なマクロを作ってる人は稀なので大抵は

P10、12を修正

の様に列挙したリストも渡さないといけないので、そんなマクロを作ってみた。

WORD文書には

ヘッダかフッタに頁番号のフィールドを割り当てておく。

マクロを配置するEXCELのワークシートには

な感じで対象WORD文書名、赤字、頁番号と書いたセルにタイトル行と名付け、対象WORD文書名の下に赤字を探すWORD文書のファイル名を入れておく。

赤文字頁番号検索マクロを実行すると

図の様に見つけた赤字とその頁番号がワークシートに書き込まれる。

そんなマクロのメイン処理はこんな感じ。

Public Sub 赤文字頁番号検索()
On Error GoTo err1

    '初期化
    Dim wordApp As Word.Application
    Set wordApp = CreateObject("Word.Application")
    '
    Dim 赤字の開始行 As Long
    赤字の開始行 = ActiveSheet.Range("タイトル行").row + 1

    Dim 赤字の列 As Long
    赤字の列 = ActiveSheet.Range("タイトル行").Find("赤字").Column
    
    Dim 頁番号の列 As Long
    頁番号の列 = ActiveSheet.Range("タイトル行").Find("頁番号").Column

    '検索対象のWORD文書を開く
    Dim wordFname As String
    wordFname = 検索対象のWORD文書名を調べる
    Dim wordDoc As Word.document
    Set wordDoc = 検索対象のWORD文書を開く(wordApp, wordFname)
    If TypeName(wordDoc) <> "Nothing" Then
        '赤文字を1文字選択する
        Call 赤文字を1文字選択する(wordDoc)
        '選択中の文字と同じ属性の文字を全て選択状態にする
        Call 選択中の文字と同じ属性の文字列を全部クリップボードにコピる(wordDoc)
        'ワークシートに貼り付ける
        ActiveSheet.Cells(赤字の開始行, 赤字の列).Select
        ActiveSheet.Paste
        'ワークシートの選択状態のセルの文字を検索する
        Dim row As Long
        For row = 赤字の開始行 To 赤字の開始行 - 1 + Selection.Count
            Dim text As String
            text = ActiveSheet.Cells(row, 赤字の列).Value
            Dim 頁番号 As Integer
            頁番号 = 赤字テキスト検索(wordDoc, text)
            If 頁番号 > 0 Then
                '右セルに頁番号を書き込む
                ActiveSheet.Cells(row, 頁番号の列).Value = 頁番号 & "頁"
            Else
                ActiveSheet.Cells(row, 頁番号の列).Value = "見つかりません"
            End If
            'ワークシートの選択状態の最後のセルまで繰り返す
        Next row
    End If
exit1:
    Call MSWORDをそのまま閉じる(wordApp)
    Exit Sub

err1:
    MsgBox Err.Description
    GoTo exit1

End Sub

察しが付いたと思うがとても長いし、WORD「選択」で複数個の選択状態になった場合、VBAでその結果にダイレクトにアクセスする方法がみあたらなかったので、一旦クリップボードに入れてワークシートに書き出し、1つづつ頁番号を調べているので、処理が終わるまでじっと待たなければいけない。

以下、サブルーチン群。

セル名を使っているけど、単なる趣味でしかない。

Private Function 検索対象のWORD文書名を調べる() As String
    
    Dim ファイル名列 As Integer
    ファイル名列 = ActiveSheet.Range("タイトル行").Find("対象WORD文書名").Column
    Dim wordFname As String
    wordFname = ActiveSheet.Cells(ActiveSheet.Range("タイトル行").row + 1, ファイル名列)
    'ドライブレターやパスが無い場合
    If InStr(wordFname, "\") = 0 Then
        wordFname = ActiveWorkbook.Path & "\" & wordFname
    End If
    検索対象のWORD文書名を調べる = wordFname

End Function

普通にWORD文書を開くとマクロのデバッグでSTOPしたりすると時々EXCELの裏に「壊れたWORD文書です。xxxxx」と表示されたりするので、読み取り専用で開くのが吉。

Private Function 検索対象のWORD文書を開く(wordApp As Word.Application, docPath As String) As Word.document
On Error GoTo err1

    '読み取り専用
    Set 検索対象のWORD文書を開く = wordApp.Documents.Open(Filename:=docPath, ReadOnly:=True)
    Exit Function

err1:
    MsgBox Err.Description
    Set 検索対象のWORD文書を開く = Nothing

End Function

WORDの「高度な検索」で「書式」から赤字を指定した場合のマクロ

Private Sub 赤文字を1文字選択する(wordDoc As Word.document)

    '赤文字を検索
    wordDoc.ActiveWindow.Selection.Find.ClearFormatting
    wordDoc.ActiveWindow.Selection.Find.Font.Color = wdColorRed
    
    With wordDoc.ActiveWindow.Selection.Find
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
    End With
    
    wordDoc.ActiveWindow.Application.Selection.Find.Execute
    
    '1文字だけ選択する
    wordDoc.ActiveWindow.Selection.End = wordDoc.ActiveWindow.Selection.Start + 1

End Sub

WORDの「類似した書式の文字列を選択」のマクロ

Private Sub 選択中の文字と同じ属性の文字列を全部クリップボードにコピる(wordDoc As Word.document)

    '類似した書式の文字列を選択するWordマクロ三種     https://www.ka-net.org/blog/?p=5486
    wordDoc.Application.Run "SelectSimilarFormatting"
    'Application.CommandBars.FindControl(ID:=5946).Execute
    'Application.CommandBars.ExecuteMso "SelectTextWithSimilarFormatting"
    
    'クリップボードにコピる
    wordDoc.ActiveWindow.Selection.Copy

End Sub

赤字な特定の文字列を検索するマクロ

Private Function 赤字テキスト検索(wordDoc As Word.document, text As String) As Integer

    赤字テキスト検索 = 0
    With wordDoc.Content.Find
        '赤文字を指定
        .ClearFormatting
        .Font.Color = wdColorRed
        'テキストを指定
        .text = text
        '順方向を指定
        .Forward = True
        'いざ検索
        .Execute
        '結果は?
        If .Found = True Then
            wordDoc.ActiveWindow.Selection.Start = .Parent.Start
            wordDoc.ActiveWindow.Selection.End = .Parent.End
            '頁番号を返す
            赤字テキスト検索 = wordDoc.ActiveWindow.Selection.Information(wdActiveEndAdjustedPageNumber)
            Exit Function
        End If
    End With

End Function

意外と面倒なWORDの終了

ループしなくても

wordApp.Documents.Close SaveChanges:=wdDoNotSaveChanges

で済むらしいけど、念のためループしている。

Private Sub MSWORDをそのまま閉じる(ByRef wordApp As Word.Application)

    Dim idx As Integer
    For idx = 1 To wordApp.Documents.Count
        wordApp.Documents(idx).Close SaveChanges:=wdDoNotSaveChanges
    Next
    wordApp.Quit
    Set wordApp = Nothing

End Sub



【Excel】マクロや計算式を除外して保存する方法

資料を作る時はVLOOKUPとか、いっぱい数式が入ってる。

しかし、誰かに渡す時は安心して扱えるように全ての数式をデータに変換しておきたい時がある。

※何気にキーを押すと数式が#ERRORを吐くことがあるから

具体的には、

  1. 全シート(但し、非表示シートを除く)を選択状態
  2. 全セルを選択
  3. ワークシートをコピー
  4. 値(あるいは計算結果)を使用するモードで、ワークシートにペースト
  5. 普通のExcelファイルに保存

するダケ。

'全シート選択
Dim worksheet As Worksheet
Dim wss() As String
Dim cnt As Integer
cnt = 0
For Each worksheet In Worksheets
  If worksheet.Visible = xlSheetVisible Then
    cnt = cnt + 1
    ReDim Preserve wss(cnt -1)
    wss(cnt - 1) = woeksheet.Name
  Else
    '確認メッセージを非表示
    Application.DisplayAlerts = False
    'ワークシートを削除
    worksheet.Delete
    '確認メッセージを表示
    Application.DisplayAlerts = True
  End If
Next
Sheets(wss).Select

'コピー
Cells.Select
Selection.Copy

’データ貼り付け
Selection.PasteSpecial Paste:= xlPasteValues, _
  Operation:= xlNone, _
  SkipBlanks:= False, _
  Transpose:= False

'セル選択の解除
Application.CutCopyMode = False

全シート選択時は非表示シートが含まれているとエラるので注意。

非表示シートは不要なら削除して手渡しした方が良いかもしれないけど

確認メッセージが出るのがうざい。

そうなるとマクロも消して保存したくなる。

名前を変えて保存で、ファイルの種類を「Excel ブック (*.xlsx)」に切り替えて保存すればいいが

マクロ記録したコードでは

読めないExcelファイルを保存しまいがち

実際エラったり散々なようだ。

  • MSのサイトではエラったら・・・・・・・・
  • FileFormatパラメータは 1を使う
  • FileNameパラメータは 拡張子を省く

ことをお勧めしていた。

確かにエラーは発生しないものの。

使い物にならないEXCELファイルになってしまう

※開くと「アカン!読めんw」と泣きが入る

※開くと「一部読めんw」と呟いて、書式が壊れCSVファイルを読んだ様な画面になる

色々試した結果

こうなった。

Dim bookName as String
bookName = ActiveWorkbook.Name
bookName = Replace(ActiveWorkbook.Name,".xlsm","xlsx")
Dim bookNamePath
bookNamePath = Split(ActiveWorkbook.FullName,"\")
ReDim Preserve bookNamePath(UBound(bookNamePath)-1)
bookNamePath = Join(bookNamePath,"\")
ChDir bookNamePath
'確認メッセージを非表示
Application.DisplayAlerts = False
'普通のExcelファイルに保存
ActiveWorkbook.SaveAs Filename:= bookName, _
  FileFormat:= xlOpenXMLWorkbook, _
  Password:= "", _
  WriteResPassword:= "", _
  ReadOnlyRecommended:= False, _
  CreateBackup:= False
'確認メッセージを表示
Application.DisplayAlerts = True
'処理完了メッセージ
MsgBox bookNamePath & "\" & bookName & vbCrLf & "へ名前を変えて保存"

SaveAsのパラメータは

  • FileFormatパラメータは xlOpenXMLWorkbook を使う
  • FileNameパラメータは 拡張子をxlsx に変える

これで、確認メッセージは出てくるもののちゃんと保存できたし、マクロも消えていた。

しかし、このコードがいつのまにか使い物にならなくなっている可能性がきわめて高いのが

MSクオリティ。

PS.2022/6/10

てか、サブPCの古いExcelで動作をチェックしてたので、色々支障がありました。

今のExcelなら【Microsoft365用】Excelのマクロや計算式を除外して保存する方法を参考にしてください。

後、ReadOnlyRecommendedの綴りがまちがっていたので訂正。多分、何度も貼り換えてるうちに変になったんだろうなぁ・・・



【Win11】NASのiSCSIグループに割り当てたドライブが表示されない

PCを起動すると、NASのiSCSIのグループに割り当てたドライブが表示されない時がままある。

iSCSIイニシエータを見ると

再接続中。つまり繋がっていない。

ここで早まって【切断】し、IPアドレスを入力して【ENTER】キーを押すと、

「クイック接続」になってしまい

PCを再起動すると、今は「再接続中」になる。

この「システムの再起動後ターゲットは利用できなくなります。」の意味は、

・【切断】に失敗する

・再「クイック接続」できない ※できる場合もあるかもしれない。

くらいに「ターゲットは(一切)利用できなくなります。」と云う意味だ。

仕方が無いので、

「探索」「お気に入り」のタグからNASのIPアドレスを覚えている箇所を削除し、

再起動時にNASのことをすっかり忘れてもらった隙に

IPアドレスを入力し今度は【ENTER】キーには一切触れず【接続】ボタンを押さなければいけない。

※うっかり【ENTER】キーを押してしまった場合は、「探索」「お気に入り」タグから削除しなおして再起動。

無事「ターゲットの接続」画面が表示されれば【OK】を押すと、

PC起動時にNASのiSCSIグループにに再ログインしてくれるようだ。

しかし、これで暫く繋がっていたハズなんだが・・・

根本的な対策にはならないんだよね。




top