dsorano – リボン日記

日報データを週報データに変えるSUM関数をイミディエイトに書き出す

Excel で日報データを週報に変えて、長期間のグラフを見やすくしようとした。SUM()関数を使って日報のデータを週報に集計すればいいのだが、手入力で範囲指定するとミスが出るのでVBAで書き出した。

ただし、なぜかVBA でタブが扱えなかったので、区切りが半角スペースになっている。これをテキストエディタの検索置換でタブに変えて、Excel のセルに貼れば、狙った通りの週報に変わる。

条件

セルはB2 とC2から下方向に日報データが並んでいるものとする。

コード

Option Explicit

'// 日報データを週報データに変えるSUM関数をイミディエイトに書き出す
Sub OutWeek()
  '//初期化
  Dim sumNum(5) As String
  Dim cellNum(1) As Long
  Dim ij As Long
  '//=SUM(B2:B8) =SUM(C2:C8)
  '//のように、B列、C列の2行目から日報データを集計する関数を書き出す
  sumNum(1) = "=SUM(B"
  sumNum(2) = ":B"
  sumNum(3) = ")    =SUM(C" '//BとCの間をタブ区切りにしてエクセルのセルに直接貼れるようにしたいが、タブがなぜか半角スペースに変換される
  sumNum(4) = ":C"
  sumNum(5) = ")"
  '//1週間の始まりと終わりの行
  cellNum(0) = 2
  cellNum(1) = 8
  '//53週(371日)分書き出す
  For ij = 1 To 53
    '//文字列と行数を結合してイミディエイトに書き出す
    'Str() で数字を文字列に変換、整数にすると文頭に半角スペースが入るので、CutLeft() で切り取り
    Debug.Print sumNum(1) + CutLeft(Str(cellNum(0)), 1) + sumNum(2) + CutLeft(Str(cellNum(1)), 1) + sumNum(3) + CutLeft(Str(cellNum(0)), 1) + sumNum(4) + CutLeft(Str(cellNum(1)), 1) + sumNum(5)
    '//7日後の行を指定
    cellNum(0) = cellNum(0) + 7
    cellNum(1) = cellNum(1) + 7
  Next ij
End Sub
'// 引数１：文字列
'// 引数２：削除文字数
'// 戻り値：削除後の文字列
Function CutLeft(s, i As Long) As String
    Dim iLen    As Long     '// 文字列長
    
    '// 文字列ではない場合
    If VarType(s) <> vbString Then
        Exit Function
    End If
    
    iLen = Len(s)
    
    '// 文字列長より指定文字数が大きい場合
    If iLen < i Then
        Exit Function
    End If
    
    '// 指定文字数を削除して返す
    CutLeft = Right(s, iLen - i)
End Function

Option Explicit

'// 日報データを週報データに変えるSUM関数をイミディエイトに書き出す

Sub OutWeek()

'//初期化

Dim sumNum(5) As String

Dim cellNum(1) As Long

Dim ij As Long

'//=SUM(B2:B8) =SUM(C2:C8)

'//のように、B列、C列の2行目から日報データを集計する関数を書き出す

sumNum(1) = "=SUM(B"

sumNum(2) = ":B"

sumNum(3) = ") =SUM(C" '//BとCの間をタブ区切りにしてエクセルのセルに直接貼れるようにしたいが、タブがなぜか半角スペースに変換される

sumNum(4) = ":C"

sumNum(5) = ")"

'//1週間の始まりと終わりの行

cellNum(0) = 2

cellNum(1) = 8

'//53週(371日)分書き出す

For ij = 1 To 53

'//文字列と行数を結合してイミディエイトに書き出す

'Str() で数字を文字列に変換、整数にすると文頭に半角スペースが入るので、CutLeft() で切り取り

Debug.Print sumNum(1) + CutLeft(Str(cellNum(0)), 1) + sumNum(2) + CutLeft(Str(cellNum(1)), 1) + sumNum(3) + CutLeft(Str(cellNum(0)), 1) + sumNum(4) + CutLeft(Str(cellNum(1)), 1) + sumNum(5)

'//7日後の行を指定

cellNum(0) = cellNum(0) + 7

cellNum(1) = cellNum(1) + 7

Next ij

End Sub

'// 引数１：文字列

'// 引数２：削除文字数

'// 戻り値：削除後の文字列

Function CutLeft(s, i As Long) As String

Dim iLen As Long '// 文字列長

'// 文字列ではない場合

If VarType(s) <> vbString Then

Exit Function

End If

iLen = Len(s)

'// 文字列長より指定文字数が大きい場合

If iLen < i Then

Exit Function

End If

'// 指定文字数を削除して返す

CutLeft = Right(s, iLen - i)

End Function

文字の切り取りは、この記事のものを使わせてもらった。
VBAで文字列の右側や左側から指定文字数削除する

Outlook のメールを読んで、指定した情報をVBAを使って抜き出す

データベースを使わない、または外部のウェブサービスからのメールを受信していて、そのメールの中から住所を抜き出し、顧客分布を測定したい時がある。Excel とOutlook ならVBA が使えるので、それを一部自動化した。

この解説は、限られた条件で使ったものなので、サンプルプログラムとして記録を残す。

前提

Oltlook の受信トレイに「予約」フォルダ、その直下に「A店」と「B店」のフォルダがある

受信トレイ
└予約
├A店
└B店

それぞれのフォルダはOutlook のルールで、件名ごとにフォルダ分けされるようになっている

「A店」と「B店」に保存されたメールの中に、「住所」情報がある

実装したい機能

指定したフォルダを次々に読み込んで、住所を抜き出し、都道府県、市町村、区、その他で横方向のセルに挿入する

セルは横方向が属性、縦方向がメールごとの内容にして、データを表に入力する

VBA スクリプト

'Outlook の指定フォルダから､一気にメール内容の住所を取得して､都道府県､市､区､で分ける
'「住所」の次の行を調べているだけなので、メールがメールフォームを使わずに返信してきた場合は住所が決まった位置に書かれていないため抜ける

'全てのプロシージャで使用できる変数宣言
Dim subFolder As String ' サブフォルダ名
Dim folderArray() As String ' 選択するフォルダ名
Dim nextRow As Long '挿入するセルの開始行

Sub GetCustomersAddress()

    '初期設定
    'フォルダ構造は次のようになっている
    '受信トレイOutlook 2013
    '└予約
    '　├A店
    '　├B店
    '　└C店
    ReDim folderArray(2)
    subFolder = "予約"
    folderArray(1) = "A店"
    folderArray(2) = "B店"

    nextRow = 2

    '指定したフォルダ内にGetMail()の処理を実施する
    Call GetMail(subFolder, folderArray(1), nextRow)
    Call GetMail(subFolder, folderArray(2), nextRow)

End Sub

'Outlook にある指定されたフォルダを順に読み込み、「住所」が書かれた行の次の行にある住所を、都道府県、市区町村、以下で分けてセルに記載する
Function GetMail(ByVal nowFolder As String, ByVal ssFolder As String, ByVal nowRow As Long)
    Dim objOutlook As Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myInbox, mySubfolder

    Set objOutlook = New Outlook.Application ' Outlook アプリケーションオブジェクトの取得
    Set myNamespace = objOutlook.GetNamespace("MAPI") ' Outlook のメールフォルダにアクセスするためのNamespace オブジェクトを取得
    
    ' GetDefaultFolder() の引数olFolderInbox は、受信トレイフォルダー(メール)を指す
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox) ' 受信トレイのフォルダオブジェクトを取得
    Set mySubfolder = myInbox.Folders(nowFolder).Folders(ssFolder) ' 引数で指定された階層のサブフォルダオブジェクトを取得


    Dim i As Long
    Dim ij As Integer
    Dim textSolo As String
    Dim stringLine As String
    Dim sPrefecture As String
    Dim sCity As String
    Dim sKu As String

    ' 取得したサブフォルダmySubfolder のアイテム数をすべて読む
    For i = 1 To mySubfolder.Items.Count
      'シート"email"を指定
      With ThisWorkbook.Worksheets("email")
        arrayLine = Split(mySubfolder.Items(i).Body, vbCrLf) 'メール本文を改行で分割
        '住所を書き出す
        For ij = LBound(arrayLine) To UBound(arrayLine)
            stringLine = arrayLine(ij)
            ' 行が指定のキーワード「住所」なのか確認
            If stringLine Like "*住所*" Then
                textSolo = arrayLine(ij + 1)
                '都道府県
                If (InStr(textSolo, "道") <> 0) Or (InStr(textSolo, "東京都") <> 0) Or (InStr(textSolo, "府") <> 0) Then
                    sPrefecture = Mid(textSolo, 1, 3) ' 都道府県を取得
                    textSolo = Right(textSolo, Len(textSolo) - 3) ' testSolo から都道府県を削除
                ElseIf (InStr(textSolo, "県") <> 0) Then
                    sPrefecture = Mid(textSolo, 1, InStr(textSolo, "県"))
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "県"))
                ElseIf (InStr(textSolo, "名古屋市") <> 0) Then
                    '名古屋市から書き始める人用
                    sPrefecture = "愛知県"
                End If
                .Cells(i + nowRow, 2).Value = sPrefecture ' 都道府県を指定されたセルに記載
                
                '市
                If (InStr(textSolo, "市") <> 0) Then
                    sCity = Mid(textSolo, 1, InStr(textSolo, "市")) ' 市を取得
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "市")) ' textSolo から市までを削除
                ElseIf (InStr(textSolo, "郡") <> 0) Then
                    sCity = Mid(textSolo, 1, InStr(textSolo, "郡"))
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "郡"))
                Else
                    sCity = ""
                End If
                .Cells(i + nowRow, 3).Value = sCity ' 市を指定されたセルに記載
                '区
                If (InStr(textSolo, "区") <> 0) Then
                    sKu = Mid(textSolo, 1, InStr(textSolo, "区")) ' 句を取得
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "区")) ' textSolo から区までを削除
                Else
                    sKu = ""
                End If
                .Cells(i + nowRow, 4).Value = sKu ' 区を指定されたセルに記載
                .Cells(i + nowRow, 5).Value = textSolo ' それ以外の住所を指定されたセルに記載
            End If
        Next
      End With
    Next i

    nextRow = nowRow + mySubfolder.Items.Count
End Function

100

101

102

103

'Outlook の指定フォルダから､一気にメール内容の住所を取得して､都道府県､市､区､で分ける

'「住所」の次の行を調べているだけなので、メールがメールフォームを使わずに返信してきた場合は住所が決まった位置に書かれていないため抜ける

'全てのプロシージャで使用できる変数宣言

Dim subFolder As String ' サブフォルダ名

Dim folderArray() As String ' 選択するフォルダ名

Dim nextRow As Long '挿入するセルの開始行

Sub GetCustomersAddress()

'初期設定

'フォルダ構造は次のようになっている

'受信トレイOutlook 2013

'└予約

'　├A店

'　├B店

'　└C店

ReDim folderArray(2)

subFolder = "予約"

folderArray(1) = "A店"

folderArray(2) = "B店"

nextRow = 2

'指定したフォルダ内にGetMail()の処理を実施する

Call GetMail(subFolder, folderArray(1), nextRow)

Call GetMail(subFolder, folderArray(2), nextRow)

End Sub

'Outlook にある指定されたフォルダを順に読み込み、「住所」が書かれた行の次の行にある住所を、都道府県、市区町村、以下で分けてセルに記載する

Function GetMail(ByVal nowFolder As String, ByVal ssFolder As String, ByVal nowRow As Long)

Dim objOutlook As Outlook.Application

Dim myNamespace As Outlook.Namespace

Dim myInbox, mySubfolder

Set objOutlook = New Outlook.Application ' Outlook アプリケーションオブジェクトの取得

Set myNamespace = objOutlook.GetNamespace("MAPI") ' Outlook のメールフォルダにアクセスするためのNamespace オブジェクトを取得

' GetDefaultFolder() の引数olFolderInbox は、受信トレイフォルダー(メール)を指す

Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox) ' 受信トレイのフォルダオブジェクトを取得

Set mySubfolder = myInbox.Folders(nowFolder).Folders(ssFolder) ' 引数で指定された階層のサブフォルダオブジェクトを取得

Dim i As Long

Dim ij As Integer

Dim textSolo As String

Dim stringLine As String

Dim sPrefecture As String

Dim sCity As String

Dim sKu As String

' 取得したサブフォルダmySubfolder のアイテム数をすべて読む

For i = 1 To mySubfolder.Items.Count

'シート"email"を指定

With ThisWorkbook.Worksheets("email")

arrayLine = Split(mySubfolder.Items(i).Body, vbCrLf) 'メール本文を改行で分割

'住所を書き出す

For ij = LBound(arrayLine) To UBound(arrayLine)

stringLine = arrayLine(ij)

' 行が指定のキーワード「住所」なのか確認

If stringLine Like "*住所*" Then

textSolo = arrayLine(ij + 1)

'都道府県

If (InStr(textSolo, "道") <> 0) Or (InStr(textSolo, "東京都") <> 0) Or (InStr(textSolo, "府") <> 0) Then

sPrefecture = Mid(textSolo, 1, 3) ' 都道府県を取得

textSolo = Right(textSolo, Len(textSolo) - 3) ' testSolo から都道府県を削除

ElseIf (InStr(textSolo, "県") <> 0) Then

sPrefecture = Mid(textSolo, 1, InStr(textSolo, "県"))

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "県"))

ElseIf (InStr(textSolo, "名古屋市") <> 0) Then

'名古屋市から書き始める人用

sPrefecture = "愛知県"

End If

.Cells(i + nowRow, 2).Value = sPrefecture ' 都道府県を指定されたセルに記載

'市

If (InStr(textSolo, "市") <> 0) Then

sCity = Mid(textSolo, 1, InStr(textSolo, "市")) ' 市を取得

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "市")) ' textSolo から市までを削除

ElseIf (InStr(textSolo, "郡") <> 0) Then

sCity = Mid(textSolo, 1, InStr(textSolo, "郡"))

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "郡"))

Else

sCity = ""

End If

.Cells(i + nowRow, 3).Value = sCity ' 市を指定されたセルに記載

'区

If (InStr(textSolo, "区") <> 0) Then

sKu = Mid(textSolo, 1, InStr(textSolo, "区")) ' 句を取得

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "区")) ' textSolo から区までを削除

Else

sKu = ""

End If

.Cells(i + nowRow, 4).Value = sKu ' 区を指定されたセルに記載

.Cells(i + nowRow, 5).Value = textSolo ' それ以外の住所を指定されたセルに記載

End If

End With

Next i

nextRow = nowRow + mySubfolder.Items.Count

End Function

動作

スクリプトを実行すると、シート”email”に結果を書き出す

英語学習の現状-2020年2月

以前、「新社会人を英日の翻訳者に育てる」を書いた。その時は、ヒアリングとスピーキングを除外していた。その後わたしが、リーディングと写経では英語の理解力が伸びない問題にぶち当たった。現在、それを改善している。

以前の学習方法

「自分が興味のある分野の英語記事」を1日2本、テキストエディタを使って写経する
わからない単語を辞書引きして手帳に書きとる
それでもわからない時は、Google 翻訳ツールで翻訳して記事を読む
手帳の単語を後で見返す

着眼点

多言語の学習は、「ヒアリングの刺激があると効率が良くなる」と、脳科学の研究者がまとめていた。そこで、ヒアリングを始めた。

ヒアリングの習慣づけ

朝起きたとき、”BBC Learning English” を1本、繰り返して聞く。(スマートフォンアプリを使っている。)
- 6 Minute English
- 6 Minute Grammar
- 6 Minute Vocabulary
興味のある分野の解説動画やハウツーをYouTube で見る
- ジムのバイクを漕いでいる最中によく見ている

備考

Google 翻訳コミュニティを使うようになった。

利用者に利益があるか知りたいので参加している。今のところ、「熟語」が見えるようになってきた。

翻訳できるならそのまま訳し、分からない単語があれば辞書を引く。表現がおかしいものがあれば旗をクリックして「不適切」、「翻訳できない」などを伝える。手掛かりがない場合は「スキップ」して時間を縮める。

Google 翻訳コミュニティとは

Google 翻訳の正誤表を、人力で行うプロジェクト。それぞれの言語間に「翻訳」と「検証」の二種類の作業を、1度に10個ずつこなすボランティア。

Excel の複数のシートで、セルの頭出しをしたい

データの整理で、Excel を使って、別のシートからのデータをコピペする作業がある。毎回決まった位置に目視で確認しながらマウス操作で選択していたが、この頭出しをVBA で実現した。

利用する言語

Visual Basic for Applications (VBA)

実装したい内容

決まったシートから順番に、指定したセルの位置を選択状態にしたい

スクリプト

Option Explicit
' スリープを使う
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'初期設定
Dim ij As Integer

'セル頭出し関数実行
Sub F1st()
    Call FocusCell("C86")
End Sub
Sub F2nd()
    Call FocusCell("C117")
End Sub
Sub F3rd()
    Call FocusCell("C146")
End Sub
' セル頭出し、シートを順番に選択して、指定されたセルを選択状態にする
Function FocusCell(ByVal tCell As String)
    For ij = 4 To Sheets.Count
        Sheets(Sheets(ij).Name).Select
        Sleep 50
        Range(tCell).Activate
        Sleep 50
    Next
    ' 先頭のセルを再び選択
    Sheets(Sheets(4).Name).Select
End Function

Option Explicit

' スリープを使う

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'初期設定

Dim ij As Integer

'セル頭出し関数実行

Sub F1st()

Call FocusCell("C86")

End Sub

Sub F2nd()

Call FocusCell("C117")

End Sub

Sub F3rd()

Call FocusCell("C146")

End Sub

' セル頭出し、シートを順番に選択して、指定されたセルを選択状態にする

Function FocusCell(ByVal tCell As String)

For ij = 4 To Sheets.Count

Sheets(Sheets(ij).Name).Select

Sleep 50

Range(tCell).Activate

Sleep 50

' 先頭のセルを再び選択

Sheets(Sheets(4).Name).Select

End Function

内容

セル頭出し関数F1st() などで、選択するセルの位置を指定
FocusCell() でシート4から順番にシートを選択して、指定されたセルを選択する

AutoHotKey で配列がなぜ関数の中で使えないのを解決する

AutoHotKey を使い始めた人が他の言語を経験していると、「配列が関数の中で参照できない」と詰まることがある。これを解決する。

結論から言えば、グローバル配列を参照するなら、宣言が必要となる。

検証スクリプト

test.ahk

Array := Object()
Array[0] := "item"
Array[1] := 1
Array[2] := 3

MsgArrayTest1() ; 結果：{空白}, {空白}
MsgArrayTest1()
{
	Array[1] := Array[1] + 1
	MsgBox % Array[1]
	MsgBox % Array[0]
}

MsgArrayTest2() ; 結果：2, item
MsgArrayTest2()
{
	global Array ; グローバル変数を参照するための宣言
	Array[1] := Array[1] + 1
	MsgBox % Array[1]
	MsgBox % Array[0]
}

MsgVariable(Array[0]) ; 結果： item
MsgVariable(outString)
{

	MsgBox %outString%
}

MsgArray(Array) ; 結果：3
MsgArray(outString)
{
	MsgBox % outString[2] 
}

Array := Object()

Array[0] := "item"

Array[1] := 1

Array[2] := 3

MsgArrayTest1() ; 結果：{空白}, {空白}

MsgArrayTest1()

{

Array[1] := Array[1] + 1

MsgBox % Array[1]

MsgBox % Array[0]

}

MsgArrayTest2() ; 結果：2, item

MsgArrayTest2()

{

global Array ; グローバル変数を参照するための宣言

Array[1] := Array[1] + 1

MsgBox % Array[1]

MsgBox % Array[0]

}

MsgVariable(Array[0]) ; 結果： item

MsgVariable(outString)

{

MsgBox %outString%

}

MsgArray(Array) ; 結果：3

MsgArray(outString)

{

MsgBox % outString[2]

}

AutoHotKey で何かの自動処理を実行中に、ツールチップを表示させて利用者に知らせる

AutoHotKey を実行中、実行が終わったかどうかをタスクバーの常駐アイコンを見てチェックしているが、とても面倒だ。そこで、ツールチップを使って、AutoHotKey の実行中だと画面上で知らせる方法を考えた。

テストスクリプト

tooltip_cancel.ahk

; AutoHotKey で何かの自動処理を実行中に、ツールチップを表示させて利用者に知らせる

SetTimer, ToolTipMessage, 100 ;サブルーチンを指定間隔で実行する
Return

ToolTipMessage:
  CoordMode,ToolTip,Screen ; ツールチップをスクリーン上での絶対座標をとる
  ; ToolTip, {表示するメッセージ、改行は`n を使う},X ,Y
  ToolTip, 実行を終了するときは`nESC キーを押す,0 ,0
Return

ESC::
  ExitApp ; アプリを終了
  Exit ; AHK を終了

; AutoHotKey で何かの自動処理を実行中に、ツールチップを表示させて利用者に知らせる

SetTimer, ToolTipMessage, 100 ;サブルーチンを指定間隔で実行する

Return

ToolTipMessage:

CoordMode,ToolTip,Screen ; ツールチップをスクリーン上での絶対座標をとる

; ToolTip, {表示するメッセージ、改行は`n を使う},X ,Y

ToolTip, 実行を終了するときは`nESC キーを押す,0 ,0

Return

ESC::

ExitApp ; アプリを終了

Exit ; AHK を終了

解説

ToolTip で、メッセージと表示位置を設定する
CoordMode, ToolTip, Screen で、ツールチップをスクリーン上での絶対座標をとるようにする。初期状態は、アクティブウィンドウの左上からの相対座標

使い方

tooltip_cancel.ahk を実行すると、モニター上の左上にツールチップが表示され続ける
メッセージや表示座標を、用途に合わせて変更する
本機能と関係ないが、ESC キーの入力でアプリを終了する機能は、動作時間の長いスクリプトでも役に立つ

AutoHotKey でウィンドウのタブを切り離して、好きな場所に移動してリサイズする

Windows で使うアプリで、タブ形式のウインドウを切り離して再配置する作業を手動で行っている。これを自動で行いたい。その方法をAutoHotKey での実装を考えた。

操作

タブをマウスで左クリックドラッグして切り離す

新しくできたウインドウを移動させて、指定のサイズに変更する

マウス操作するときに、ドラッグ開始位置とドラッグ終了位置は、「AutoHotKey でマウスカーソルの座標をリアルタイムで取得したい」を動作させて、メモする

ソース

CoordMode,Mouse,Screen ; マウスカーソルでスクリーン上での絶対座標をとる
; MouseClickDrag, LEFT,X1,Y1,X2,Y2,SPEED
MouseClickDrag, LEFT,-450,-40,653,20,10 ; マウス左クリックで、X1,Y1 から、X2,Y2 にスピード10(範囲2～100)でドラッグする
sleep,2000

; WinMove,WinTitle,, X, Y,Width,Height ;
; WinTitle に"A" を指定すると、アクティブなウィンドウを指定できる
WinMove,A,, 40, 40,600,600	; X,Y に移動して、Width,Height にウィンドウをリサイズする

CoordMode,Mouse,Screen ; マウスカーソルでスクリーン上での絶対座標をとる

; MouseClickDrag, LEFT,X1,Y1,X2,Y2,SPEED

MouseClickDrag, LEFT,-450,-40,653,20,10 ; マウス左クリックで、X1,Y1 から、X2,Y2 にスピード10(範囲2～100)でドラッグする

sleep,2000

; WinMove,WinTitle,, X, Y,Width,Height ;

; WinTitle に"A" を指定すると、アクティブなウィンドウを指定できる

WinMove,A,, 40, 40,600,600 ; X,Y に移動して、Width,Height にウィンドウをリサイズする

備考

利用するアプリに、タブを切り離すみたいな操作があればそれを使っているが、タブを切り離すという発想がタブウィンドウにないためか、それができない。

AutoHotKey でマウスカーソルの座標をリアルタイムで取得したい

Widnows アプリでショートカットも指定できない、マウス操作で解決する必要がある操作で、AutoHotKey を使いたい。まず、マウスカーソル座標などを取得する方法を探った。

ソース

get_mouse_condition.ahk

SetTimer, WatchCursor, 100 ;サブルーチンを指定間隔で実行する
Return
#Persistent ;スクリプトを常駐状態にする

WatchCursor:
  CoordMode,Mouse,Screen ; マウスカーソルでスクリーン上での絶対座標をとる
  MouseGetPos, xpos, ypos , id, control ; マウスカーソルの座標、マウス下のウィンドウのウィンドウハンドルを格納する、マウス下のコントロールのClassNN を格納する
  WinGetTitle, title, ahk_id %id% ; 指定されたウィンドウのタイトルを取得
  WinGetClass, class, ahk_id %id% ; 指定されたウィンドウのクラス名を取得 
  ToolTip, ahk_id %id%`nahk_class %class%`n%title%`nControl: %control%`nX%xpos% Y%ypos%. ;ツールチップで現在の情報を表示
Return

SetTimer, WatchCursor, 100 ;サブルーチンを指定間隔で実行する

Return

#Persistent ;スクリプトを常駐状態にする

WatchCursor:

CoordMode,Mouse,Screen ; マウスカーソルでスクリーン上での絶対座標をとる

MouseGetPos, xpos, ypos , id, control ; マウスカーソルの座標、マウス下のウィンドウのウィンドウハンドルを格納する、マウス下のコントロールのClassNN を格納する

WinGetTitle, title, ahk_id %id% ; 指定されたウィンドウのタイトルを取得

WinGetClass, class, ahk_id %id% ; 指定されたウィンドウのクラス名を取得

ToolTip, ahk_id %id%`nahk_class %class%`n%title%`nControl: %control%`nX%xpos% Y%ypos%. ;ツールチップで現在の情報を表示

Return

使い方

スクリプトを実行すると、ツールチップで現在のマウスポインタ座標などが出るので、それをメモする

使い終わったら、常駐しているAutoHotKey スクリプトを終了させる

追記：2020年1月29日（水）

ESC キーを押して終了したい場合は、次のスクリプトを追加する

get_mouse_condition.ahk

ESC::
  ExitApp ; アプリを終了
  Exit ; AHK を終了

ESC::

ExitApp ; アプリを終了

Exit ; AHK を終了

#Persistent の設定を追加した

AutoTotKey のHotstring で、当年の指定日の年月日(曜日)を素早く入力する

前回、今日の年月日をHotstring で素早く入力する方法を実装した。今度は、指定日の年月日を素早く入力する方法を実装する。Excel のセルに「月/日」を入力すると暦と認識される機能の応用だ。

方法

AutoHotKey のHotstring を使う

Hotstring とは

ユーザーが特定の文字列をタイプしたときに、アクションを発生させられる機能

スクリプト

my_hotstring.ahk

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;今年の指定日の日付を入力する
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;t[[ → 年月日＋曜日を入力する Hotstring  本体
::t[[::
  ; 入力フォーム作成
  Gui,Add,Text, yp+10,指定日[4ケタ]
  Gui,Add,Edit,x100 yp-4 vTargetDate w50 Limit4 Number ; 入力フォーム、4ケタ、数字のみの制限
  Gui,Add,Button,gInsDateExec x170 yp-2 default,&OK ; オプションで default を指定すると、Enter が押されたときにそのボタンのラベルが処理されます
  Gui,Show
return

InsDateExec:
  Gui,Submit
  Gui,Destroy
  ;今年の年を取得
  FormatTime, YearString,, ShortDate
  StringMid,YearString,YearString,1,4 ; 年を取得
  ;取得した月日のテキストから曜日を取得
  FormatTime, dayString,%YearString%%TargetDate%000000,WDay
  ;取得したテキストから年月日を取得
  FormatTime, targetString,%YearString%%TargetDate%000000,LongDate
  ;曜日を(月)の形式に変換
  dowstr := get_dowstr(dayString)
  clipboard = %targetString% %dowstr%
  Send, +{INSERT}
Return

;入力フォームキャンセルで、Gui を破棄
;キャンセル、エスケープキー、閉じるに対応
ButtonCancel:
GuiEscape:
GuiClose:
  Gui,Destroy
Return

;曜日をカッコつきで返す
get_dowstr(theNum)
{
;##### 引数が正しく引き渡されていない
    dowtable := "日月火水木金土"
    ; Wday は日曜日が 1、
    ; StringMid のStartChar は、取り出す部分の開始位置。StringGetPosと違い、1文字目が 1。
    dowstr := ""
    StringMid, dowstr, dowtable, %theNum%, 1
    return "(" dowstr ")"
}

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;今年の指定日の日付を入力する

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;t[[ → 年月日＋曜日を入力する Hotstring 本体

::t[[::

; 入力フォーム作成

Gui,Add,Text, yp+10,指定日[4ケタ]

Gui,Add,Edit,x100 yp-4 vTargetDate w50 Limit4 Number ; 入力フォーム、4ケタ、数字のみの制限

Gui,Add,Button,gInsDateExec x170 yp-2 default,&OK ; オプションで default を指定すると、Enter が押されたときにそのボタンのラベルが処理されます

Gui,Show

return

InsDateExec:

Gui,Submit

Gui,Destroy

;今年の年を取得

FormatTime, YearString,, ShortDate

StringMid,YearString,YearString,1,4 ; 年を取得

;取得した月日のテキストから曜日を取得

FormatTime, dayString,%YearString%%TargetDate%000000,WDay

;取得したテキストから年月日を取得

FormatTime, targetString,%YearString%%TargetDate%000000,LongDate

;曜日を(月)の形式に変換

dowstr := get_dowstr(dayString)

clipboard = %targetString% %dowstr%

Send, +{INSERT}

Return

;入力フォームキャンセルで、Gui を破棄

;キャンセル、エスケープキー、閉じるに対応

ButtonCancel:

GuiEscape:

GuiClose:

Gui,Destroy

Return

;曜日をカッコつきで返す

get_dowstr(theNum)

{

;##### 引数が正しく引き渡されていない

dowtable := "日月火水木金土"

; Wday は日曜日が 1、

; StringMid のStartChar は、取り出す部分の開始位置。StringGetPosと違い、1文字目が 1。

dowstr := ""

StringMid, dowstr, dowtable, %theNum%, 1

return "(" dowstr ")"

}

使い方

普段使いするなら、このmy_hotstring.ahk をランチャーに入れて実行するか、Windows のスタートアップで起動時に実行されるようにする

“t[[” と入力すると、指定日入力フォームが表示される

指定日を半角英数4ケタ”0101″ のように入力してエンターキーを押すと、”2020年1月1日 (水)” のように出力される

解説

入力フォーム作成に、Gui,Add,Edit を使っている
フォームに入力した内容は、TargetDate に代入される
Gui,Add,Button で処理が実行されたらInsDateExec 関数を実行する
今年の西暦年をYearString に取得
入力された日付とYearString を使って、指定日の曜日を取得
入力された日付とYearString を使って、年月日を取得
指定日の曜日を、get_dowstr() を使って、「(月)」の形式に変換

参考

AutoHotkey の Hotstring で曜日文字列を素早く入力する
 http://stakiran.hatenablog.com/entry/2018/01/19/221444

英文作成時にポンドやユーロを素早く入力したい

英文作成時にこれまで、ポンドやユーロの価格記号を漢字変換を使って入力していた。これを1秒で入力できるようにしたい。今回も、AutoHotKey のHotstringで実装した。

方法

AutoHotKey のHotstring を使う

Hotstring とは

ユーザーが特定の文字列をタイプしたときに、アクションを発生させられる機能

スクリプト

my_hotstring.ahk

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Hotstring のオプション. 自分好み.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; - 終了文字無しで発動させる
; 0 自動置換後、最後に終了文字を入力しない
#Hotstring *
#Hotstring O


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;ユーロ、ポンド入力
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;ユーロ、ポンドの記号は、ファイルをSJIS で保存すると文字化けするので、UTF-8 BOM付きで保存する必要がある。
::e[[::
	clipboard = €
	Send, +{INSERT}
return
::p[[::
	clipboard = £
	Send, +{INSERT}
return

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Hotstring のオプション. 自分好み.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; - 終了文字無しで発動させる

; 0 自動置換後、最後に終了文字を入力しない

#Hotstring *

#Hotstring O

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;ユーロ、ポンド入力

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;ユーロ、ポンドの記号は、ファイルをSJIS で保存すると文字化けするので、UTF-8 BOM付きで保存する必要がある。

::e[[::

clipboard = €

Send, +{INSERT}

return

::p[[::

clipboard = £

Send, +{INSERT}

return

使い方

普段使いするなら、このmy_hotstring.ahk をランチャーに入れて実行するか、Windows のスタートアップで起動時に実行されるようにする

“p[[” と入力すると、”£” のように出力される