2021-09-24

表に罫線を付ける (左端列の共通値入力範囲を区切る)

えっと、夏が終わりましたね。

こんちくわ壁|ω・)ﾉ

先日Twtterで表に罫線を付けるツールを作ったよ～と呟いたら、ビックリするくらい反応(当社比)がありました。
面倒くさくって困っているの同じようなツールが欲しいとか、内容をブログでアウトプットして～といった声も上がったので、調子に乗って紹介したいと思います。

表に罫線を付けるツールを作りました。
左端の分類に合わせて下線をつけるのがアピールポイントです。

この作業をよくやるのですが、手でやるのは地味に面倒臭いんですよねぇ。

ん？そんなん使わない・ω・)？ pic.twitter.com/xLZS7Oj6sd
— FukuCyndi papa (@FukucyndiP) 2021年9月23日

でわいきます￣▽￣)ﾉ

どんなツールを作ったのか

ただ表に罫線を付けるだけならどうってことないのですが、作ったツールのポイントは、

　左端列で同じ入力値がある塊を視覚的に区別する仕切り線を付ける

というところです。

f:id:FukuCyndiP:20210924014351p:plain

(A列の都道府県の塊を区分けする線が引かれていますね(なんちゃって個人情報を利用させていただきました))

もちろん手でやってできることではあるのですが、行数が塊ごとに違ったりして、何度もやってると徐々に精神が削られていくことになります -ω-)

そこで、この塊を認識して下線を追加する機能を付けた表罫線ツールというのを思い立ちました。

塊認識システム

今回の記事では、特定の範囲内を走査して入力値が同じセル範囲を取得するロジックをメインに紹介しようと思います。
コードでは同じ入力値を含むセル範囲(Rangeオブジェクト)を集積した配列を返すFunction プロシージャとして作成しています(コードは最後に掲載しますので、ご興味がある方はご覧ください)

１．同じ入力値の範囲を見つける → 入力値が変わるところを見つける

f:id:FukuCyndiP:20210924014505p:plain

２．入力値が変わるセルセットをそれぞれ配列に集積

f:id:FukuCyndiP:20210924014530p:plain

３．(n)番目の境界下と(n+1)番目の境界上のセルを組み合わせて共通範囲を取得

　 f:id:FukuCyndiP:20210924014545p:plain

４．取得した共通範囲を配列に集積

f:id:FukuCyndiP:20210924014559p:plain

基本的なロジックは上記の通りなのですが、走査範囲の上下端など、少しややこしそうなところは以下のように処理しています。

ややこし案件１：走査範囲の上端セル

一番上のセルは境界上下のゼロ番として配列に集積します　　 f:id:FukuCyndiP:20210924014619p:plain

ややこし案件２：走査範囲の下端のセル

上端のセルと同様に境界上下の最終番として配列に集積します
f:id:FukuCyndiP:20210924014637p:plain

ややこし案件３：特定の入力値を含むセルが1つしかない

f:id:FukuCyndiP:20210924014650p:plain

と、ざっくりとこんな感じですね。
その他、罫線の引き方とか件線を引く範囲の指定などありますが、そこはマクロの記録をベースに作って工夫も何もしていないので、実際のコードを見ていただければと思います。

まとめ

今回は表に罫線を付ける際に、表の左端の共通項目に仕切り線を付けるロジックについて書きました。
対象範囲を2つのセル単位で走査して、入力値が異なるペアを見つけることがを基本しました。私なりの工夫ですので他にもいいロジックがあるかもしれませんが、ご参考になれば幸いです。また、筆者はこのプログラムを右クリックメニューに登録して利用していますが、常用するなら右クリックメニュー登録がおススメです。

右クリックメニューへの登録については過去に記事を書いているのでご参考にしてください

fukucyndip.hatenablog.com

ソースコード

今回作成したコードを以下に書きます記事で描いた共通範囲認識処理は FindAreaOfSameData プロシージャになります。

 Option Explicit

'”表に分類毎の罫線を付ける”の実行に必要なプロシージャはココから
'----------------------------------------------------------------------

Public Sub 表に分類毎の罫線を付ける()
'　選択した表範囲に罫線を付ける。
'　　項目行下：二重線
'　　左端列：分類毎に下線
'   選択した表全体に太線枠を付ける
    
    With Selection
        Call AllLineClear(Selection)

' 　　同じ入力値を含むRangeオブジェクトを集積した配列を作成する
        Dim arrArea As Variant
        arrArea = FindAreaOfSameData(.Range(.Columns(1).Address))　

        Dim temp As Variant
        For Each temp In arrArea
            Call 下線(temp.Resize(temp.Rows.count, .Columns.count))
        Next
    
        Call 下二重線(.Rows(1))
    End With
    Call 外周太線(Selection)
End Sub



'FindAreaOfSameData実行に必要なプロシージャはココから
'----------------------------------------------------------------------
Private Function FindAreaOfSameData(ByRef targetColumnDataArea As Range) As Variant
    '表のタイトル文字列で指定した列データを上から捜査して、セル内容が同じ範囲をRageオブジェクトとして配列化する
    '　    wsName: 対象データを含むワークシート名
    '       targetColumnTitle：表のカラムタイトル文字列
    
    With targetColumnDataArea.Parent
        Dim cellsOnBorder() As Variant
        Dim cellsUnderBorder() As Variant
        Dim areaNum As Long
        Call FindCellsBetweenBorders(targetColumnDataArea, cellsOnBorder(), cellsUnderBorder(), areaNum)
        
        Select Case areaNum
            Case Is > 2
                Dim areasSameData() As Variant
                ReDim areasSameData(UBound(cellsOnBorder) - 1)
                Dim i As Long
                For i = 0 To UBound(cellsOnBorder) - 1
                    Set areasSameData(i) = .Range(cellsUnderBorder(i), cellsOnBorder(i + 1))
                Next
            Case 2
                '対象範囲の文字列は1種類かつ対象範囲の下に別の文字列がない場合
                ReDim areasSameData(0)
                Set areasSameData(0) = .Range(cellsUnderBorder(0), cellsUnderBorder(1))
            Case 1
                '対象範囲の文字列は1種類かつ対象範囲の下にも別の文字列がある場合
                ReDim areasSameData(0)
                Set areasSameData(0) = .Range(cellsUnderBorder(0), cellsUnderBorder(0))
        End Select
    End With
    FindAreaOfSameData = areasSameData
End Function


Private Sub FindCellsBetweenBorders(ByVal targetColumnDataArea As Range, ByRef cellsOnBorder() As Variant, _
                                                        ByRef cellsUnderBorder() As Variant, ByRef areaNum As Long)
    '表のタイトル文字列で指定した列データを上から走査して、セル内容が変化する境目(Border)を挟んだ上下のRangeオブジェクトを配列化する
    '引数
    '　    wsName: 対象データを含むワークシート名
    '       targetColumnTitle：表のカラムタイトル文字列
    '       cellsOnBorder() : 境目の上にあるセルrengeオブジェクトを集めた配列作成用(配列として宣言する)
    '       cellsUnderBorder():境目の下にあるセルrengeオブジェクトを集めた配列作成用(配列として宣言する)
    
    With targetColumnDataArea.Parent

         'カラムの一番上のセルはcellsOnBorder、cellsUnderBorder両方に代入する
        ReDim Preserve cellsOnBorder(1)
        ReDim Preserve cellsUnderBorder(1)
        Set cellsOnBorder(0) = targetColumnDataArea.Cells(1)
        Set cellsUnderBorder(0) = targetColumnDataArea.Cells(1)
        
        Dim temp As Variant
        Dim i As Long: i = 1
        For Each temp In targetColumnDataArea
'        Debug.Print temp.Value, temp.Offset(1, 0).Value
'                Debug.Print temp.Address, temp.Offset(1, 0).Address
            If StrConv(temp.Value, vbLowerCase) <> StrConv(temp.Offset(1, 0).Value, vbLowerCase) Then
                 'カラムの一番下のセルはcellsOnBorder、cellsUnderBorder両方に代入する
                If Application.Intersect(targetColumnDataArea, temp.Offset(1, 0)) Is Nothing Then
                    '対象範囲の文字列は1種類かつ対象範囲の下に別の文字列がない場合
                    Set cellsOnBorder(i) = temp
                    Set cellsUnderBorder(i) = temp
                    i = i + 1
                    Exit For
                Else
                    ReDim Preserve cellsOnBorder(i + 1)
                    ReDim Preserve cellsUnderBorder(i + 1)
                    Set cellsOnBorder(i) = temp
                    Set cellsUnderBorder(i) = temp.Offset(1, 0)
                    i = i + 1
                End If
            Else
                '対象範囲の文字列は1種類かつ対象範囲の下にも別の文字列がある場合
                If Application.Intersect(targetColumnDataArea, temp.Offset(1, 0)) Is Nothing Then
                    Set cellsOnBorder(i) = temp
                    Set cellsUnderBorder(i) = temp
                    i = i + 1
                End If
            End If

        Next
        areaNum = i
    End With

End Sub
    
'FindAreaOfSameData実行に必要なプロシージャはココまで
'----------------------------------------------------------------------


Private Sub 下線(ByRef target As Variant)
'　引数targetで受け取った範囲に下罫線を付ける
    With target.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

End Sub
Private Sub 外周太線(ByRef target As Variant)
'　引数targetで受け取った範囲の外周に太線を付ける
    Dim edges As Variant
    edges = Array(xlEdgeTop, xlEdgeLeft, xlEdgeBottom, xlEdgeRight)
    
    Dim temp As Variant
    For Each temp In edges
        With target.Borders(temp)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
    Next

End Sub
Private Sub 下二重線(ByRef target As Variant)
'　引数targetで受け取った範囲の下に二重線を付ける
    With target.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

End Sub
Private Sub AllLineClear(ByRef target As Range)
'　引数targetで受け取った範囲の罫線をリセット
    With target
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
End Sub

'”表に分類毎の罫線を付ける”の実行に必要なプロシージャはココまで
'----------------------------------------------------------------------

2021-03-20

ID文書の翻訳ツールをつくる4 (改行処理コードの修正でハマったおハナシ)

花粉症の薬をもらいに病院行こうと思た土曜日。
祭日で病院がお休みだったと気が付いたら、急に目がかゆくなってきました。

こんちくわ壁|ω・)ﾉ

今回の記事は、
さぁ役者はそろった‼　いざ実行・・・・・したら、
まさかの改行処理部分に不具合があって、ハマってしまった。。なおハナシです。

でわいきます￣▽￣)ﾉ

Contents

前回の記事では・・・
コピペすると文章の途中に改行が挿入される
ところが・・
結局どういうことだったのか
まとめ
因みに

前回の記事では・・・

VBAでIEを操作してアクセスしたDeepLサイトに翻訳した文字列情報を投げるコードを紹介しました。
コーディングのポイントは以下の通りでした。

下準備として、参照設定 Microsoft Internet Controls, Microsoft Internet Controls を有効にする
InternetExplororクラスメンバーを使ってDeepLサイトにアクセスする
Edgeの開発者ツールを使ってDeepLサイトの翻訳元データを書き込む範囲に該当するHTMLコードを特定(lmt＿textarea lmt＿source_textarea lmt__textarea_base_style クラスで書かれている機能単位（？）)
HTMLHeaderElementクラスメンバー .GetElemensByClassName()メソッドでそのクラスユニットに翻訳したい文字列情報を代入する(理解不足だけどうまくいった)
SendKeysメソッドを使って "Enter" ボタンをクリックする

これで、コピー → クリップボードの中身を取り出し → 改行処理 → DeepLサイトに投げる　の機能単位がそろって当初想定していた処理が可能になった・・・・ハズでした。

コピペすると文章の途中に改行が挿入される

このシリーズの最初の記事でも触れましたが、英文PDF文書をコピペすると、文章の途中に改行が挿入されるケースがあります。

　
f:id:FukuCyndiP:20210320193156p:plain

(フリーアクセスジャーナルの一部を利用させていただきました。Plants 2021, 10, 586.)

で、エクセルにペーストすると、

f:id:FukuCyndiP:20210320193232p:plain

の、ようにPDF元文書の改行位置に合わせて、文章の途中に改行コードが挿入された状態でペーストされてきます。
その結果翻訳結果も微妙になるため、この改行コードを半角スペースに変換する以下のコードを最初に作成ました。

Sub 改行をスペースに変換()
　　'選択されたセルの文字列にある改行コードを半角スペースに変更する
    Selection.Value = Replace(Selection.Value, Chr(10), " ")  
    'Chr(10)は vbLFでもおＫ
End Sub

f:id:FukuCyndiP:20210221002705g:plain
(ワークシート上で動作確認：ちゃんと目的通りの結果となる)

ところが・・

そこで必要な機能単位がおおむねそろったところで、以下のようなプロセスで翻訳処理を実行したところ、

PDF文字列をコピー(手作業)
　　↓クリップボード情報を変数に代入
　　↓改行を半角スペースに削除
　　↓処理後の文字列をDeepLサイトの所定の場所に導入
　　↓翻訳を開始

なぜかDeepLサイトに挿入された文書には改行が残っている　(・3・)ｱﾙｴｰ？？？

f:id:FukuCyndiP:20210320193351p:plain

と、いうわけでハマりました -ω-)

結局どういうことだったのか

では、何がいけなかったのか。

改行処理コード作成時、コピーした文字列をワークシートにペーストしながら動作確認をしていたのですが、ペースト後のセル文字列とクリップボードの中では改行コードが異なっていたため、動作確認結果が実操作では反映されなかったということでいた。

まず、VBAで利用できる改行コードは以下の通りです。

組み込み定数	Chr No	説明
vbCr	Chr(13)	キャリッジリターン
vbLf	Chr(10)	ラインフィード
vbCrLf	Chr(13)+Chr(10)	キャリッジリターンとラインフィードの組み合わせ
vbNewLine	Chr(13) + Chr(10) または Macintosh では Chr(13)	プラットフォーム毎で指定された改改行文字

でわ、ワークシートにペースト後と、クリップボードの中身ではどの改行コードが使われていたのか検証すると、

f:id:FukuCyndiP:20210320194230p:plain

＜ワークシートにペーストされたもの＞ ⇒ Chr(10) : vbLf

f:id:FukuCyndiP:20210320194348p:plain

＜クリップボードの中身＞ ⇒ Chr(13)とChr(10) : vbCrLf/vbNewline
(先の記事で紹介した Function ClipBordContents() を使いました)

f:id:FukuCyndiP:20210320194310p:plain

このようにクリップボードに格納されているとき採用されていたのはChr(10)とChr(13) の両方(vrCrLf)だったのですね。なので、Chr(10)のみの変更では足りなかったということだったのです。
さらにワークシートのセルに#コピッペすると、なぜか Chr(13) がなくなるという挙動が事をややこしくしたのでした。

というわけで、改行処理コードは以下のように修正して、無事意図した処理を実現できたのでした。

Sub 改行をスペースに変換()
　　'選択されたセルの文字列にある改行コードを半角スペースに変更する
    Selection.Value = Replace(Selection.Value, vbCrLf, " ")  
    'vbNewLineでもおｋ
End Sub

まとめ

今回の記事では改行コードが挿入されている文字列情報では、それをどのように処理するかによって利用されている改行コードが変化することがあるということを書きました。

改行処理コードを書く際、改行コードが悪さをしているのか最初に探る訳ですが、いくつかあるものの中から vbLf(Chr(10)) が有効だということを確認したうえでのコーディングでした(その時点で vbCrLf は不採用)。

エクセルですから、VBAですから、当然動作確認はワークシート上でやっていたわけですが、まさかセルにペーストすると改行コードが変わるとは夢にも思っていなくってハマる結果となりました。結果的には文字コードを見直すことで事なきを得ましたが、いい経験値を積むことができました。

ワード文書に移した場合やその他の処理でどうなるかは検証できていませんが、そういうことがあるということは頭の隅に置いておいて損はなさそうです。

でわまた～￣▽￣)ﾉｼ

因みに

vbCrLf は Chr(10)と Chr(13)の組み合わせと書きましたが、修正コードの vbCrLf 部分は以下のように Chr() で置き換えても目的の処理をすることはできませんでした。

Chr(10) & Chr(13)
Chr(10) & " " & Chr(13)
Chr(10) + Chr(13)

イミディエイトに ?ASC(vbCrLf) と聞くと、 13 ﾀﾞﾖｰと返ってくるのですが、Chr(13)単独でも同じくダメでした。vbCrLfは vbCrLfでしか表現できないような感じですが、どうなんでしょうね・ω・)

2021-03-14

PDF文書の翻訳ツールを作る3　(DeepL翻訳サイトにテキストデータを投げる)

VBA案件

筆者地方ではスギ花粉はピークを過ぎたそうです。
んが、筆者はスギは軽くってヒノキの方がつらいのです。。
そう。本当の戦いはこれから始まるのです。

こんちくわ壁|ω・)ﾉ

さて、前回の記事の続きです。
今回はいよいよ翻訳する文字列をDeepLサイトに投げる処理について紹介します。

でわいきます￣▽￣)ﾉ

Contents

前回の記事では・・・
クリップボードから取得した文字列をDeepLサイトに投げる
まとめ

前回の記事では・・・

クリップボードから文字情報を引っ張り出しすFuncrionプロシージャについて書きました。コーディングのポイントは以下の通り。

クリップボードからのデータの出し入れにはMSfromsライブラリの DataObjectクラスのメンバーであるGetFromClipboardメソッドと GetText メソッドを利用する
その下準備として、Microsoft Forms 2.0 Object Library を有効にするための参照設定を行う
クリップボードの中身を空にするのにApplication.CutCopyMode=Falseが使える
クリップボードの中身が空かどうかの判定は　Application.ClipboardFormats(1) の値を参照する

これで、Functionプロシージャ ClipBordContents()作ったのでした。

クリップボードから取得した文字列をDeepLサイトに投げる

いきなりですが、出来上がったコードです

Private Sub DeepL翻訳()
    'ClipBordContents関数で取り出したクリップボードの中身targetTextに格納する
    Dim targetText As String: targetText = ClipBordContents()

    Dim URL As String: URL = "https://www.deepl.com/ja/translator"
    Dim objIE As SHDocVw.InternetExplorer: Set objIE = New SHDocVw.InternetExplorer    
    objIE.Visible = True
    
    Call objIE.navigate(URL)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
    Loop
    
    'Deeplサイトへの
    'クラス名は"lmt__textarea" または "lmt__textarea lmt__source_textarea" でもおｋ
    Dim objInpTxt As MSHTML.HTMLHeaderElement
    Set objInpTxt = objIE.document.getElementsByClassName("lmt__textarea lmt__source_textarea lmt__textarea_base_style")(0)
    objInpTxt.Value = targetText

    
    SendKeys "{ENTER}"

End Sub

短いコードですがそれぞれの内容について紹介しますね

IEを起動してサイトにアクセスする

VBAを使ったスクレイピングについてはいろんなところで紹介されていますのであまり詳しくは書きませんが、記事で足りない情報はGoogle先生にお伺いするとよいと思います。

まず最初に、VBAを使ったインターネットエクスプローラー(IE)の操作には、Microsoft Internet Controls(SHDocVw.DLL)ライブラリの InternetExplorerクラスメンバーを使います。また、後述するHTMLに対する操作ではMicrosoft HTML Object Library(MSHTML.DLL)ライブラリを利用しますので、参照設定する下準備をしておきます。

f:id:FukuCyndiP:20210313234433p:plain

コーディングは InternetExplorerクラスメンバーを憑依させたオブジェクト(インスタンス) objIE を生成 (New) した後に objIE.xxxx と記述してメンバーを呼び出しながら進めていきます(インスタンスの名前はなんでもおｋ）。

コード的には、以下の2つの構成がほぼお約束的な書き方になっています。

１．IE インスタンスを生成してIEウィンドウを表示

' InternetExplorerクラスから、インスタンスobjIEを生成(New)
' .Visibleメソッドで IEウィンドウを表示する
    Dim objIE As SHDocVw.InternetExplorer: Set objIE = New SHDocVw.InternetExplorer
    objIE.Visible = True

　2．目的のサイトにアクセスして、読み込み待ちをする

' .Navigateメソッド(引数URL:アクセスしたいサイトのURL)、目的のサイトにアクセスする
' .Busyまたは .ReadyStateプロパティで読み込み完了したか否かを判定して、読み込み未完の場合はOSに処理を渡す
    Call objIE.navigate(URL)
    Do While objIE.Busy = True Or objIE.readyState <> 4 'objIE.readyState < READYSTATE_COMPLETEでもおｋ
        DoEvents
    Loop

.Busyは文字通りIEが忙しい状態かどうか。
.Readystate はサイトの読み込み状態を示します(Readystateプロパティの戻り値については以下の通り)

列挙体記述	定数	説明
READYSTATE_UNINITIALIZED	0	未完了状態
READYSTATE_LOADING	1	IEオブジェクトのロード中
READYSTATE_LOADED	2	IEオブジェクトのロード完了。ただし、操作不可能
READYSTATE_INTERACTIVE	3	IEオブジェクトの操作可能状態
READYSTATE_COMPLETE	4	IEオブジェクトの全データ読み込み完了

DoEventsについては以下のサイトが参考になります

news.mynavi.jp

DeepLの翻訳ウィンドウにテキストを入れる

今回のコードのメインエベント的な部分ではあるのですが、実わ理解不十分なところもあって、手探りでこうしたらなんかうまくいった的な感じなコードの紹介になってしまいます。

すまそん。。。

で、クリップボードから取り出した文字列情報はすでに変数に代入済み。ぢゃぁ、それをDeepLサイトの所定の位置に投入するためには、HTMLで記述されているDeepLサイトのどの要素をどういじればいいのか？と、いうのがHTML知識がほぼゼロな筆者には大問題なわけです。　　

f:id:FukuCyndiP:20210313225932p:plain

でもEdgeの機能いじくり倒すことで、大体コレ的なものをつかむことができました。

恥ずかしげもなく大公開すると、

手順１．Edgeの開発者ツールを起動します

f:id:FukuCyndiP:20210313230021p:plain

手順2．開発者ツールをポチすると、なんかコードが右にずらーっと出現します。
思わず気が遠くなりそうになりますが、意識をつないでその上にあるマウスポインタの絵をクリックします

f:id:FukuCyndiP:20210313230106p:plain

すると、該当するコード部分がハイライトされます。

f:id:FukuCyndiP:20210313230129p:plain

この状況でもまだまだ気持ちを保つのにエネルギーが必要な状況ではありますが、落ち着いて示された先を見ると、

＜textarea class="lmt__textarea lmt__source_textarea lmt__textarea_base_style" ...... lang＞＜/text area＞

というHTML特有の機能単位を示す記述のパターン(＜xxx＞...＜/xxx＞)が目に入って、この辺のclassをいじくればいいのかもしれない・・・と、希望の糸が見えてきます。

と、いうわけでそんな根拠のない見通しとGoogle先生のご助言を基に試行錯誤して作成したのが以下のコードになります。

    Dim objInpTxt As MSHTML.HTMLHeaderElement
    'クラス名は"lmt__textarea" または "lmt__textarea lmt__source_textarea" でもおｋ
    Set objInpTxt = objIE.document.getElementsByClassName("lmt__textarea lmt__source_textarea lmt__textarea_base_style")(0)
    objInpTxt.Value = targetText 'targetText：翻訳したいテキストを格納

” lmt＿textarea lmt＿source_textarea lmt__textarea_base_style” クラスで指定されるオブジェクトをgetElementsByClassName メソッドで特定して、そこに翻訳したい文字列を代入するような記述になりました。

実行すると、DeepL画面の目的の場所に翻訳したい文字列が入ったので、これでヨシ!!

"(0)" がオブジェクトの要素ゼロ番を意味するのか、配列のインデックス番号なのか結局わからなかったけろヨシ！

識者の方のご意見お待ちしております<(＿＿)>

Enterする

DeepLサイトは、翻訳したい文章をウィンドウにコピペすると自動で翻訳を開始します。つまり "翻訳ボタンがない" のですね。

試行錯誤しつつもめでたく所定の枠に目的の文書を導入することに成功した訳ですが、そのままだと何時までたっても翻訳が始まらず、ぽっつーんな感じになります。でも、追加で "Enter" すれば翻訳が始まるため、

  SendKeys "{ENTER}"

ハイ。Enterキーをコード的に押すヤツですね。
これを最後に差し込むことで、ちゃんと翻訳を始めように仕向けることができました。

本当は自動翻訳開始のコマンドを探したかったのですが、ビジュアル頼みの解読では手がかりすらつかむことができず-ω-)

まとめ　　

今回の記事ではクリップボードから取得した文字列情報を DeepLサイトの所定の位置に挿入して翻訳を開始させるコードを紹介しました。いくつかの参照設定とそのメンバーを使うことで、IEを起動 → サイトを開いて → 好きな操作をするというこがVBAでちゃんとできることを自分なりに確認することができました。

一方でDeepLサイト操作など、頼みのGoogle先生がほとんどご存じないとなると一気に苦戦するわけでして、、当たり前ではありますがHTMLについてのある程度の知識は必要ですね。今回は#ノンプロ研御大タカーシさんの隣itのシリーズ記事をあれこれ参照しながら試行錯誤させていただきました。

tonari-it.com

時間はかかりましたが何とかなるものですね。

さて今回の記事で、英文PDFの文章をコピーしてそれをそのままDeepLサイトに自動で放り込んで翻訳してもらう本体コードはできました。

次回以降の記事ではもう一歩踏み込んで、DeepL翻訳を利用する上で気が付いた課題とそれに合わせたコードの追加や、使いやすさを追求した工夫について紹介したいと思います。

でわまた～￣▽￣)ﾉｼ

2021-02-28

PDF文書の翻訳ツールを作る2(クリップボードの中身を取得する)

熱くなったり寒くなったり、お外も忙しい感じな今日この頃です

こんちくわ壁|ω・)ﾉ

さて、前回の記事の続きです。
今回は作った翻訳ツールで利用したクリップボード内の文字列情報取得について紹介したいと思います。

でわいきます￣▽￣)ﾉ

Contents

前回の記事では・・・
それで、作った翻訳マクロではどんな工夫したの？
クリップボードの中身を取り出して変数に代入する
クリップボードの中身を空にする
クリップボードの中身が空かどうかを確認する
クリップボードの中身を返すFunction プロシージャ
まとめ
因みに

前回の記事では・・・

以下のことを書きました

英語のPDF文献をコピーしてWeb翻訳ツールにペーストすると、文章の途中に改行コードが挿入された状態でペーストされてしまうために翻訳がうまく機能しない
改行コード(Chr(10)/vbCrLf)を半角スペースに変更するマクロを作ったけれども、ワークシートにコピペして、処理してWebページに貼りつけるなど翻訳操作にメッチャ手間がかかる
操作の多くを自動化して手間を削減し、かつGoogleよりも精度が高いDeepL翻訳サイトを利用するマクロを作った

fukucyndip.hatenablog.com

それで、作った翻訳マクロではどんな工夫したの？

前回紹介した ”改行 → 半角スペース変換”　マクロを使った翻訳作業では

    1. 文献の該当部部分をコピー  
    2. エクセルのワークシートのどっかのセルをダブルクリック  
    3. ペースト  
    4. VBE起動
    5. 改行をスペースに変換マクロを起動
    6. 出来上がった文章が入ったセルをダブルクリッ  
    7. 文書全体を選択
    8. コピー
    9. ブラウザを起動(DeepL)して翻訳サイトにアクセス
    10. 文書をペーストしてEnter
    11. 待つ

という手順が必要だったわけですが、PDF文書 → ワークシート, ワークシート → DeepLサイトへのコピペがたるいんですよねぇ。全部手作業だし。。ってか、結局改行処理しかマクロ使ってないし。

そこでふと気が付いたのが、

　クリップボードの中身を直接取り出して変数に入れれたらいいぢゃん！
　なんかできる気がする。。

そこで、Google先生に伺ったところ・・・、
ありました。VBAで取り出す方法が！

クリップボードの中身を取り出して変数に代入する

クリップボードの中身を取得するにはMSFormsライブラリの DataObject クラス のメンバーであるGetFromClipboardメソッドと GetText メソッドを利用します。

さらに、MSFormsライブラリを利用する下準備として、Microsoft Forms 2.0 Object Library を有効にするための参照設定を行います(ツール → 参照設定 → "Microsoft Forms 2.0 Object Library" チェックボックスをオンにする)

f:id:FukuCyndiP:20210227234607p:plain

コード例

Sub クリップボードの中身を取り出す()
'クリップボードの中身は文字列な前提です
    Dim cbContents As Variant
    
    Dim clipBoard As MSForms.DataObject: Set clipBoard = New MSForms.DataObject
    With clipBoard
        Call .GetFromClipboard
        cbContents = .GetText
    End With
    
    Debug.Print cbContents
    
End Sub

DataObjectクラスのメンバーを利用するために、DataObjectクラスから "clipBoard" という名前のインスタンスを新しく生成(New)しました。その後、GetFromClipboard メソッドでクリップボードをインスタンス "clipBoard" に一旦移して、GetTextメソッドを使って変数 cbContents に代入しています。

これでめでたくクリップボードの中身を取り出す術を手に入れました。

クリップボードの中身を空にする

実際の翻訳作業ではPDF文書のコピー → 翻訳を何度も繰り返すことが想定されます(少なくとも私はやる)。それで、直前にクリップボードに残っていた文字列が悪さをしないとも限らないわけで、処理としてはきちんと中身を変数に移した後はクリップボードは空にしておいた方がいい気がしました。

この空にする処理なのですが、Google先生に伺ったところ Windows API を利用との答えが返ってきて ('ω')ｸｯとなっていたところ、Application.CutCopyMode = False　が使えるということに偶然気が付きました。

ただし単独ではだめなので、ワークシートのどこかのセルのコピーとセットにします。

  Sub ClearClilpBoad()
    'ワークシートのどこでもいいのでコピーした後に、 Application.CutCopyMode = Falseしたらクリップボードが空になる
    ' Application.CutCopyMode = False単独では空にならない
    
    ActiveSheet.Range("A1").Copy
    Application.CutCopyMode = False
  End Sub

(十分に検証したわけでわありませんが、ワークシートのセルを一旦クリップボードに入れるだけなので、セルに何が入ってても大丈夫かなと。)

クリップボードの中身が空かどうかを確認する

次に、確認作業のオハナシです。
PDF文書のコピーは "選択 → 右クリ →　コピー" でもいいですが、"Ctrl + C" を利用する方も多いかと思います。で、この Ctrl + C はたまにうまくいかないことがある気がします(筆者の印象のみです。未検証です)。それでもし、うまくクリップボードに目的の文字列が入らなかった場合にはもちろん翻訳が失敗するわけで、~~それがプログラムの不具合と誤認されては癪に障る~~ ユーザーに不都合がないようコピーに失敗した旨教えてあげないといけません。

そこで、クリップボードに中身が入っていることを確認する処理を挟むことにしました。

VBAにはクリップボードの状態を確認するプロパティがちゃんと備え付けられていて、Application.ClipboardFormats(1) の値を参照することで、クリップボードに何のフォーマットデータが入っているか確認できます(事前の参照設定は、なんと不要)。

Value	Description
0	Text
1	Value
2	Picture
5	CSV format

　などなど(詳しくは公式　https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlclipboardformat をご覧ください)。

それで、空の場合は Application.ClipboardFormats(1)＝-1 となりますので、これを条件構文に組み込めばよいですね。

クリップボードの中身を返すFunction プロシージャ

というわけで、プリップボードの中身を返す機能単位として以下のようなFunctionプロシージャを作りました

  Function ClipBordContents() As String
    'クリップボーﾄﾞの中身を取り出す
    
    'クリップボードの中身有無判定。空なら　Application.ClipboardFormats(1) =-1　となる
    ' ”vbEmpty” を使いたいので、クリップボードが空なら合計値を0（ゼロ）にする
    Dim cbContent As Variant: cbContent = Application.ClipboardFormats(1) + 1
    
    Dim clipBoad As MSForms.DataObject: Set clipBoad = New MSForms.DataObject
    With clipBoad
        If Not cbContent = vbEmpty Then
            Call .GetFromClipboard
            ClipBordContents = .GetText
        Else
            Call MsgBox("文書がコピーできてませんよう", vbExclamation)
            End
        End If
    End With
    
    Call ClearClilpBoad
End Function
  
'--------------------------------------

Sub ClearClilpBoad()
    'ワークシートのどこでもいいのでコピーして、 Application.CutCopyMode = Falseしたらクリップボードが空になる
    ' Application.CutCopyMode = False単独では消えない
    
    ActiveSheet.Range("A1").Copy
    Application.CutCopyMode = False
End Sub

戻り値のあるFunction プロシージャですが、引数として受け取るものがありませんので、関数呼び出しとしては

  a=ClipBordContents()

と、教科書に書いてある関数の記述みたいになりますが、まぁしょうがないでしょうか。。かっこ()は省略可能ですが、省略するとそれが Functionプロシージャであることが余計わかりにくくなるので、つけておいた方がいい気がします。

まとめ

本日の記事では、以下のことを紹介しました。

当初は手作業が多くってたるかった一連の翻訳作業を全体としてマクロ化することでかなり楽ちんになった
コピーした文書の改行処理をメモリ上で行ったことで、文字列情報の転記が操作をなくしたことがポイント
クリップボード情報を変数に取り込む処理としてMSFormsライブラリの DataObject クラス のメンバーであるGetFromClipboardメソッドと GetText メソッドが利用できる

クリップボードの中身を取り出す処理というのは実は今回初めて書きましたが、実際に書いてみると思ってたよりもハードルが高くなかったと感じました。クリップボードを使ったデータのやり取りはエクセル外アプリケーションとのデータやり取りに利用できると思います。もちろん他にもっといい方法はあるのでしょうが、今回のコーディングを通じてエクセル外アプリをVBAで操作する得体のしれない恐れみたいなものがかなり軽減された気がしました。

次回はDeepLサイトに取り出した文字列を貼るコードを紹介したいと思います

でわまた～￣▽￣)ﾉｼ

因みに

今回は取り出すだけでしたが、同じくMSFormsライブラリの DataObject クラスメンバーのSetTextメソッド、PutInClipBoardメソッドを使って書き込むこともできます。

Sub クリップボードに文字列をセットして取り出す()

    Dim cbContents As Variant
    
    Dim clipBoard As MSForms.DataObject: Set clipBoard = New MSForms.DataObject
    With clipBoard
      'クリップボードにセット
        Call .SetText("こんちくわ")
        Call .PutInClipboard

      'クリップボードから取り出す
        Call .GetFromClipboard
        cbContents = .GetText
    End With
    
    Debug.Print cbContents
    
End Sub

SetTextメソッドで文字列をインスタンスにセットして、PutInClipBoardメソッドでクリップボードに書き込むという感じで、ちょうど取り出しとは逆のプロセスなんですね。　　

2021-02-21

PDF文書の翻訳ツールを作る1

VBA案件

2月の中旬だというのに、なんだか5月みたいな陽気な今日この頃です。

こんちくわ壁|ω・)ﾉ

今回はエクセルVBAのスクレイピング機能を使って翻訳ツールを作りましたよ～なオハナシ・・・の触りを少々。。
　

でわいきます￣▽￣)ﾉ

　
　

Contents

なぜ、そんなものを作ろうと思ったのか。
最終的に出来上がったモノは
まとめ

なぜ、そんなものを作ろうと思ったのか。

筆者は仕事柄英文の文献を読む機会が多かったりするのですが、純和風絶賛ニッポン人な筆者は必ずしも英語が得意なわけではなく、日本語の文章を読むかの如く英文を読み進めたりすることができるハズもなく・・・

つい、時間の節約を図るためにWeb翻訳ツールに文献の英文をコピペしてしまうことが多々あったりするのです。
ところがPDFファイルの文章をwebツールにコピペすると・・

・・なんか変なのです(˘•ω•˘)

f:id:FukuCyndiP:20210221001426p:plain

(Web上で公開されていた文献(Plants 2012, vol.1, p1-5)の一部を利用させていただきました)

日本語訳がかなり変ですが、コピペした英文を見ると文章の途中が不自然に改行されてることがわかります

f:id:FukuCyndiP:20210221001500p:plain:w400

この文中の改行を削除して半角スペースを入れたら、Google先生もうまく訳してくれるのですが、

f:id:FukuCyndiP:20210221001550p:plain

このくらいの文章ならまだしも、少し長い文章になるとですねぇ・・・・・たるいし、時間もかかるし、やってられんのです -ω-)。。

単純作業の繰り返しはまさしくVBA案件！　とばかりに早速以下のコードを書きました。

Sub 改行をスペースに変換()

    Selection.Value = Replace(Selection.Value, Chr(10), " ")

End Sub

f:id:FukuCyndiP:20210221002705g:plain:w450

(対象文字列をセルにペーストして処理。3行コードで一発やね)

これで翻訳サイトが有効活用できるぞー٩(ˊᗜˋ*)و

と喜んではいたのですが、この作業は

文献の該当部部分をコピー
エクセルのワークシートのどっかのセルをダブルクリック
ペースト
VBE起動
改行をスペースに変換マクロを起動
出来上がった文章が入ったセルをダブルクリック
文書全体を選択
コピー
ブラウザを起動して翻訳サイトにアクセス
. 文書をペースト
. 待つ

と、コードは３行でも翻訳文をゲットするまでにたくさんの手順が必要なのですねぇ。

そこで、この手順をできる限り自動化したい。さらにはGoogle翻訳よりも精度が高い DeepL翻訳サイトを使いたい～。

と、いうのが今回のプロジェクトになります。

最終的に出来上がったモノは

こんな感じに仕上がっておりますｗ

f:id:FukuCyndiP:20210221014303g:plain

手順も、

文献の該当部部分をコピー
エクセルのワークシートマクロ起動ボタンをポチー
待つ

と3ステップと大幅に簡略化されました。

　　　これって、エクセル要る・ω・)?

って感じの見た目になっておりますが、そこはVBAで作ったものなので・・ね^^;

まとめ

今回の記事では英文PDF文献の翻訳をVBAでやってみよう～。その動機について書きました。

英文文献を楽に読みたい一心で翻訳サイトを活用しようとしたのですが、PDF文書をサイトにコピペすると文章中にムダな改行が入ってしまって翻訳がうまく機能しないんですよねぇ。。でも、PDF文書上の改行部分に改行コードが差し込まれた状態でペーストされた結果なんだろうとすぐに気が付いたので、VBA案件一挙解決！のハズだったわけですが、実際に運用してみると面倒くさい。。そこで、もっと使い勝手をよくしようと一歩踏み込んだわけですが、当初想定していなかった課題が見つかったりして、思ったより苦労することになりました。

次回以降その中身を書いていこうと思っています。少々長いシリーズになってしまいそうですが、気長にお付き合いいただければありがたいです。

翻訳サイトを使って文献を翻訳しようとしているのは恐らく筆者だけではないと信じておりますので(職場の周囲からもPDFの翻訳がうまくできないとのボヤきが聞こえてきています)、これからの一連の記事がお役に立てればいいなぁと思っています。

でわまた～￣▽￣)ﾉｼ

2021-01-31

お道具箱を常駐させる (追記あり)

今日はお天気で暖かいですねぇ。

こんちくわ壁|ω・)ﾉ

さて今回の記事は、　　

右クリコマンドバーに登録したコマンドを常にそこに、登録用マクロ起動のF5ポチなしに、そこにあるようにしましょう～。なオハナシです。

でわいきます￣▽￣)ﾉ

Contents

前回の記事では・・
で、早い話どうするの？
個人用マクロブックって？ナニ
個人用マクロブックをどう使うの？
まだ完成でわありません。
まとめ
因みに

前回の記事では・・　

以下のことを紹介しました

CommandBars("Cell").Controls.Add(Type:=msoControlButton)でコマンドバーにマクロを登録できる
引数 Type:=msoControlPopup に変えたControl.Add()メソッドと組み合わせることでコマンドに階層構造を作れる
作った階層先にカスタムマクロ起動コマンドをまとめてしまおう
右クリコマンドバー登録サイコー

fukucyndip.hatenablog.com

ただ、

　　　マクロをいちいち起動することが、たるい・・

という本来の動機を考えると、コマンドバーに登録できるコードが手に入っても、その起動がたるいわけで、起動の操作なく、空気のように常駐させないと本質的に何の問題解決に至っていないということに気が付いてしまったのでした。

どっかの毒に詳しい女性剣士が言っていたことをふと思い出しました・・

　　　常駐はできて当たり前なんですけど、できないんだったら仕方ありませんねぇ

・・・今回の記事では認めてもらえるよう (誰に?) 常駐を実現させる方法を紹介します

で、早い話どうするの？

それわ、

　　 個人用マクロブックに右クリコマンドバー登録マクロを仕込む

ということです。
いきなりの結論ですが、思いついてしまえば実に簡単でした。

個人用マクロブックって、ナニ?

皆さんのVBEのプロジェクトエクスプローラーにこんなの出てませんか？

f:id:FukuCyndiP:20210131191027p:plain

(フォーム、クラスモジュールのフォルダは別途追加したものです)

　　　　うんにゃ、そんなものないよ・ω・)

と、いう方は何でもいいので、マクロの記録をやってみてください。

そうすると、下のウインドウが現れますので、マクロの保存先を "個人用マクロブック" してマクロの記録を実行すれば、自動的に作成されます。

f:id:FukuCyndiP:20210131191145p:plain

で、この個人用マクロブックは一度作ってしまえば、エクセルを起動するたびにバックグラウンドで立ち上がってくるようになります。筆者は頻用するコードの保管庫みたいな感じで利用しています。

個人用マクロブックをどう使うの？

個人用マクロブックの ThisWorkbook (ブックモジュール) の Workbook_Openイベントに右クリコマンドバー登録マクロを起動するコードを仕込みます。

f:id:FukuCyndiP:20210131191242p:plain

上に書いたように、個人用マクロブックはエクセルを起動する度に一緒に自動で起動されてきますので、こうしておけば、Workbook_Openイベントによって右クリコマンドバー登録マクロが自動で起動されるのです(ΦωΦ)ﾌﾌﾌ

まだ完成でわありません。

さて、個人用マクロブックは内容も含めて設定したことはエクセル終了後も保存されています。その仕組みの関係で、Workbook_Openイベントに仕込んだ起動プロシージャでマクロを登録すると、起動の度に同じものが追加されてどんどん増殖していくことになります。

(エクセルを起動するたびにお道具箱が増殖してしまいます)

f:id:FukuCyndiP:20210131191319p:plain

このままではえらいことになりますので、Workbook_Openイベントには

　　　　コマンドバーを初期化 → マクロを登録

と、なるようにコーディングします。

こんなこともあろうかとMicrosoft様はちゃーんと初期化コマンドを準備していて、Application.CommandBars("Cell").Resetで追加したコマンドを削除することができます。

というわけで、Workbook_Openイベントプロシージャは以下のようになりました。

Option Explicit

Private Sub Workbook_Open()
    Call Resetツールバー
    Call お道具箱を追加
End Sub

'--------------------------------------------
Sub Resetツールバー()
　　Call Application.CommandBars("Cell").Reset  'Callは省略可能
End Sub

Application.CommandBars("Cell").ResetはもちろんOpenイベントに直接記述してもいいですし、お道具箱追加プロシージャの中の一番最初に記述してもよいかと思います。これで何度エクセルを何度起動してもお道具箱が増殖することはありません

これで認めてもらえる(´；ω；`)ｳｯ （だから誰に？)　

まとめ

今回の記事では、個人用マクロブックのWorkbook_Openイベントを使って、マクロの右クリコマンドバー登録をエクセル起動と同時に自動で行うという方法を紹介しました。これであなたのマクロをコマンドバーに空気のように常駐させることができるかと思います。

"マクロの起動すらめんどくさい" にこだわって、無駄にエネルギーを使った結果なでわありますけれども、どんな小さなことでも繰り返しが蓄積するとストレスですよねぇ。効率化の味を知っているVBAerの皆さん方は特に "めんどくさい" の感度が高いかと思いますので、この気持ちわかっていただけると信じております。

私はこの方法でたくさんのツールを登録して普段から使っていて、何か思いついたら追加したりしています。一部のツールは同僚にも配って同じように使ってもらっていますけれども、結構評判が良かったりします。

ちっちゃなことだけど地味にめんどくさい。いちいちコードを書く程でもないよねぇ～な作業こそ、右クリメニューに最適かなと思いますので、ぜひやってみてください。

同僚の目の前で何気ないフリして使って、"なんやそれ～” な反応をいただくのもよろしいかとｗ

でわまた～￣▽￣)ﾉｼ

因みに

Application.CommandBars("Cell").Resetをブックモジュールに記載した場合、Applicationを省略すると実行時エラーとなります。

f:id:FukuCyndiP:20210131191341p:plain

ところが、標準モジュールでは省略可能なんですよね。同じApplicationメンバー(SendKeysメソッド、Columnsプロパティ）では同じことが起こるわけではないので、ブックモジュールにApplicationメンバーを記述するときは省略不可というわけではなさそうです。。

とりあえず棚上げで・・ (´・ω・)ｽﾏｿ.

追記・・・

記事を公開後にことりちゅんさんから以下のご助言をいただきました。

Excel の右クリックメニューにマクロ入れると便利ですよね！

僭越ながら注意事項をお伝えさせてください。
１．Resetすると、他のマクロによるカスタマイズも消えちゃいます。
２．CommandBarsで頭にApplicationを付けない場合、書いたモジュールによって補完がチガイマス。
— ことりちゅん@えくせるちゅんちゅん (@KotorinChunChun) 2021年1月31日

慌てて確認したところ、

.ComanndBars("Cell).Reset は右クリメニューの全てをリセットするため、メニューに他のカスタマイズをしていた場合はそれもリセットされてしまいます。

右クリメニューのカスタマイズはまだマクロ追加くらいしかやったことなかったので、あんまり意識していませんでしたが、.Resetは確かに潜在的な不具合リスクを抱えるためあまりよろしくはないかもしれません。そこで、追加したコマンドを狙い撃ちで削除できる Application.CommandBars("Cell").Controls("マクロ名").Deleteを使ったコードを下に掲載しましたので、ご参考にしていただければと思います。

もちろん .Resetが絶対ダメというわけではなく、まっさらな右クリメニューに新しいコマンド追加することを想定した今回のケースでは、全く問題はないかと思います。とわいえ、.Resetを選択するにしても、その挙動を知ったうえでの選択であった方がより望ましいのではないかと筆者は考えます。

お道具箱を常駐させるコード

Option Explicit

Private Sub Workbook_Open()
    Call お道具箱を削除
    Call お道具箱を追加
End Sub

'--------------------------------------------
Sub お道具箱を削除()
    'その時にあるControlコレクションの中から "お道具箱" を探して見つかったら削除する
    Dim ctrl As Variant
    For Each ctrl In Application.CommandBars("Cell").Controls
        If ctrl.Caption = "お道具箱" Then
           Application.CommandBars("Cell").Controls("お道具箱").Delete
        End If
    Next

End Sub

　お道具箱削除プロシージャはApplication.CommandBars("Cell").Controls("お道具箱").Delete　単独でWorkBook_BeforCloseイベントに仕込むことも考えましたが、これだと想定通りの挙動とならなかったため、先に実行する構造にしました。ですので、そのプロシージャ本体では、Application.CommandBars("Cell").Controls コレクションを走査して、"お道具箱” が見つかったら削除するというロジックになっています。初めからなかったら削除できませんからね。
　
　

２. CommandBars() に Applicationを付ける場合と付けない場合では内容が異なる

オブジェクトブラウザを確認したところ、CommandBarsには2つの顔があることがわかりました。

１．ExcelライブラリのApplicationクラスCommandBarsプロパティ
２．OfficeライブラリのCommandBarsクラス

これはつまり、省略した場合にどちらを取るかはPC側に判断を委ねるということになり、これもコード作成者の意図とは異なる動きになるリスクを孕む記述となります。つまり、他のOfficeアプリケーションと連動するようなコードを書いていた場合、ライブラリメンバとして認識された結果、意図せずエクセル以外のOfficeアプリケーション操作につながる可能性があるということになります。

もちろん、筆者の意図するところはExcel操作ですので、 Application.CommandBars() とした方がより不具合リスクが少ない書き方になりますね。省略するとしても、エクセル操作に絞ったコーディングだからそこは大丈夫と理解したうえでの省略であるべきかと思います。

また、棚上げ項目についても以下の考察をいただきました

シート・ブックモジュールでは、ThisWorkbook.CommandBarsになるので、自分自身のみ=PERSONAL.XLSBを書き換えようとします。窓がないからメニューもない。だからエラーなのかも？

あと、CommandBarsを触るときはActiveWindow.Application.にだけ処理が走るっぽいので、メニューが増えない窓があったり
— ことりちゅん@えくせるちゅんちゅん (@KotorinChunChun) 2021年1月31日

なるほどです。

個人用マクロブックのブックモジュールに記述してもブックの実体がないためコマンドが実行できないということですね。

確かに .Resetだけでなく、Application.CommandBars("Cells").Controls.Add()の場合も同じ実行時エラーになります。

一方で、個人用マクロブックにはなぜかSheet1モジュールがひっついています。それで、そこでは .Reset, .Controlls.Add()ともにエラーとなりませんでした。さらに、.Add()により、.xlsmブック側のシートの右クリメニューにコマンド追加されました。

Me.Parent.Name で親オブジェクトを調べてみると、PERSONAL.XLSBとなっていて、シートモジュールの親は実体を持たない個人用マクロブックとなっていましたため、もしかしたら、Sheetモジュールは実体の側のSheetと何らかの形でつながっているのかもしれませんね。この辺り、今一つ理解には至っていない部分もありますが、さっぱりわからなかった現象を考察するアイデアをいただき大感謝です!!

ちゅんさんどうもありがとうございました！

2021-01-31

お道具箱を作ってみよう

前回記事を更新したときは夏真っ盛りだと思ってたらいつの間にか冬ですねぇ。。
うっかりするともう春が・・こんちくわ壁|ω・)ﾉ

　
さて本日の記事は、エクセル作業で使えるツールを右クリックで呼び出せるようにしよう～なおハナシです。

例えばこんな感じのやつですね

f:id:FukuCyndiP:20210131012046g:plain:w450

でわいきます￣▽￣)ﾉ

Contents

お道具箱を作ってみよう

なぜこんなことをやろうと思ったのか・・

さて日々のエクセル作業で、ちょっとめんどくさいお馴染みの作業に遭遇しちゃったら、

　うんうん、この操作がめんどくさいからこの間コード書いたんだよねぇ～
　　　ﾄｺﾄｺ((((*´・ω・)

　　　Alt+F11 ぃ～
　　　目的のコード探してぇ～
　　　F5　　えいっ!

　　　ハイ！できた～

ってやることって、ないですか？
私はよくあります。

ところが、ある日気が付いてしまったのです。。

いちいち VBE起動して、目的のコード探して、実行する操作がたるい・・・
すぐ見つからんときもあるし・・・

すると誰かが耳元で囁きます

　　"めんどくさい" は効率化の母である (詠み人知らず)　

・・・思いつきました

セルを右クリックしたときに出るアレにマクロを登録できたら、呼び出し楽ぢゃん！！

＜セルを右クリックすると出てくるアレ＞

f:id:FukuCyndiP:20210131012816p:plain

こいつにマクロを登録するのだ!!

コンテキストメニューにマクロを登録する

エクセルVBAエキスパートスタンダードの教科書(古い方ね)に書いてあるのですが、右クリで出てくるアレ(別名コンテキストメニューというそうです)は、CommandBarsコレクションの "Cells" アイテムとして取得することができます。で、セル右クリのアレにマクロを登録するには以下のコマンドを使います

Application.CommandBars("Cell").Controls.Add([Type], [Id], [Parameter], [Before], [Temporary])

Addメソッドの各引数の内容は以下の通り (Microsoft公式)

名前	データ型	説明
Type	Variant	指定したコマンドバーに追加するコントロールの種類を指定します。使用できる定数は、MsoControl クラスの msoControlButton、msoControlEdit、msoControlDropdown、msoControlComboBox、msoControlPopup のいずれかです。
Id	Variant	組み込みのコントロールを表す整数を指定します。この引数を 1 に設定するか省略すると、指定した種類の空白のカスタムコントロールがコマンドバーに追加されます。
Parameter	Variant	組み込みのコントロールの場合、この引数はコンテナーアプリケーションでコマンドを実行するときに使用されます。カスタムコントロールの場合、この引数を使用して、Visual Basic のプロシージャに情報を渡したり、Tag プロパティの 2 番目の値のようなコントロールの情報を格納することができます。
Before	Variant	コマンドバーにおける新しいコントロールの位置を表す数字を指定します。新しいコントロールは、指定した位置にあるコントロールの直前に挿入されます。この引数を省略すると、コントロールは指定したコマンドバーの末尾に追加されます。
Temporary	Variant	True を指定すると、新しいコントロールが一時的なものになります。コンテナーアプリケーションが閉じられると、コントロールは自動的に削除されます。既定値は False です。

(全ての引数が省略可能)

で、細かいことはいいからどう書くの？
という声が聞こえてきそうですですので、下にコード例を記述してみました

これは右クリコマンドバーの一番上に "Greeting" というコードを実行するコマンド "こんにちわ" を追加するコードです

'-----------------------------------------------------------------
Sub コマンドバーにマクロを追加()
  With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
    .Caption = "こんにちわ" 　　　'メニューに表示する文字列
    .OnAction = "Greeting"　 '実行するプロシージャ名
    .Tag = "追加コマンド"　　 'コマンドの説明
  End With
End Sub

'-----------------------------------------------------------------
Sub Greeting()
  Call MsgBox("こんちくわ～")
End Sub

これを実行すると、

f:id:FukuCyndiP:20210131012952p:plain

このように右クリメニューに "こんにちわ" が追加されました。

コマンドを複数追加したい場合は、同様のコードを並べます

'----------------------------------------------------------------
Sub コマンドバーにマクロを追加()
  With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
    .Caption = "こんにちわ"
    .OnAction = "Greeting"
    .Tag = "追加コマンド"
  End With
      
  With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
    .Caption = "さようなら"
    .OnAction = "ByeBye"
    .Tag = "追加コマンド"
  End With
End Sub
'----------------------------------------------------------------

Sub Greeting()
  Call MsgBox("こんちくわ～")
End Sub

Sub ByeBye()
  Call MsgBox("さようなら")
End Sub

実行すると、

f:id:FukuCyndiP:20210131013039p:plain

めでたく、このように2つのコマンドが追加されました。

お道具箱を作る

さて、こうして皆さんは右クリコマンドバーに好きなコードを実行するコマンドを追加する術をゲットしました。けれども、調子に乗ってどんどん追加していくと右クリコマンドバーが新しいコマンドで埋め尽くされてしまって、もとからあるコマンドが使いにくくなってしまいそうです。

Application.CommandBars("Cell").Controls.Add()の Before引数でリストの位置をコントロールしたり、BeginGroupプロパティ(as boolean)で仕切り線を付けたりできたりはするのですが、右クリコマンドバーがビローンと長くなってしまうのはイケてないですよね。

そこで、コマンドバーに階層を作って自作コマンドはそこにまとめてしまえば、より使いやすくなります。

というわけで気になるコードは、以下のように記述します

Sub お道具箱にまとめる()
     
    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
        .Caption = "お道具箱" 　　'ポップアップタイトルに"お道具箱"を指定

        With .Controls.Add(Type:=msoControlButton, before:=1)
            .Caption = "こんにちわ"
            .OnAction = "Greeting"
            .Tag = "追加コマンド"
        End With
    
        With .Controls.Add(Type:=msoControlButton, before:=1)
            .Caption = "さようなら"
            .OnAction = "ByeBye"
            .Tag = "追加コマンド"
        End With

    End With
    
End Sub

Application.CommandBars("Cell").Controls.Add()の引数 TypeにmsoControlPopup を指定して、.Caption＝”お道具箱" と命名します。
さらに、その "お道具箱" に2つのコマンドを Control.Add() することで、階層構造が作成できます。

このコードを実行すると、

f:id:FukuCyndiP:20210131013938g:plain

お道具箱に2つのコマンドがまとめられましたね～ｗ。

まとめ

今回の記事ではワークブック上のセル右クリで出現するアレに好きなマクロを登録する方法と、さらにそれを呼び出しやすくまとめる方法を記載しました。最初にも書きましたが、日々のエクセル作業では地味にめんどくさい操作がちょいちょい発生するのですが、積み重なるとこれが結構ボディーブローのように効いてくるんですよね。

だからこそ、ちっちゃい作業でもコードにしてココロの救済を図るわけですけれども、それでも積み重なるとコード呼び出す作業でも、めんどくさくなってしまうものです(当社比)。

マクロ実行ボタンをワークシートに作っておくというのもひとつの解決策ではありますが、毎回新しいワークブックにボタンを複数作るというのも結構手間だったりしますよね。その点、右クリで出現するアレはエクセルに組み込まれているので一度登録してしまえば何個でも見やすい形でコマンドを呼び出すことができるのです。そういう意味では右クリ呼び出しサイコーなのです。

　

ん？

さて、ここで聡明なあなたは気が付いたかもしれません。

　　一度登録してしまえば？？

　　ひょっとして、新しくエクセルを起動する度に、右クリコマンドバー登録のコードを実行しなきゃってことか？

ハイ。

何度も書きました。　呼び出す作業がめんどくさいと。。

たとえエクセル起動後の1回であっても、それを毎日何度も繰り返しているとめんどくさくなってくるんですよねぇ。

怠惰な生き物である筆者はそこすら何とかしたいと考え、ある解決策に到達したのでした。次回の記事では右クリコマンドバー呼び出しの真髄ともいえる(当社比)その秘密を恥ずかしげもなく大公開したいと思います。

でわまた～￣▽￣)ﾉｼ

因みに・・・

上に記述しました2つのマクロを登録するコードを見ると、下のようにWith ステートメントで括りたくなりませんか？
でも残念ながらこのコードを実行しても結果的に "さようなら" のコマンドしか登録されませんご注意ください。

Sub コマンドバーにマクロを追加()
  With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
    .Caption = "こんにちわ"
    .OnAction = "Greeting"
    .Tag = "追加コマンド"

    .Caption = "さようなら"
    .OnAction = "ByeBye"
    .Tag = "追加コマンド"
  End With
End Sub

これは、

　　Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)

という記述で'追加された1つのコマンドに対して、2つのコマンドを順に登録する'という操作になるためです。
コードをステップ実行すると、メニューバーの一番上に最初に "こんにちわ" が登録されて、そのあとに "さようなら" が上書きされることがわかります。気になった方は一度試してみてくださいね～。　

目次

どんなツールを作ったのか

塊認識システム

１．同じ入力値の範囲を見つける → 入力値が変わるところを見つける

２．入力値が変わるセルセットをそれぞれ配列に集積

３．(n)番目の境界下と(n+1)番目の境界上のセルを組み合わせて共通範囲を取得

４．取得した共通範囲を配列に集積

ややこし案件１：走査範囲の上端セル

ややこし案件２：走査範囲の下端のセル

ややこし案件３：特定の入力値を含むセルが1つしかない

まとめ

前回の記事では・・・

コピペすると文章の途中に改行が挿入される

ところが・・

結局どういうことだったのか

まとめ

因みに

前回の記事では・・・

クリップボードから取得した文字列をDeepLサイトに投げる

IEを起動してサイトにアクセスする

DeepLの翻訳ウィンドウにテキストを入れる

Enterする

まとめ

前回の記事では・・・

それで、作った翻訳マクロではどんな工夫したの？

クリップボードの中身を取り出して変数に代入する

クリップボードの中身を空にする

クリップボードの中身が空かどうかを確認する

クリップボードの中身を返すFunction プロシージャ

まとめ

因みに

なぜ、そんなものを作ろうと思ったのか。

最終的に出来上がったモノは

まとめ

前回の記事では・・

で、早い話どうするの？

個人用マクロブックって、ナニ?

個人用マクロブックをどう使うの？

まだ完成でわありません。

まとめ

因みに

追記・・・

お道具箱を作ってみよう

なぜこんなことをやろうと思ったのか・・

コンテキストメニューにマクロを登録する

お道具箱を作る

まとめ

ん？

因みに・・・

まとめ　　

前回の記事では・・　