画像ファイルを名前の日付で分類(DateTime.TryParseExact の使い方メモ)

DateTime.TryParseExact メソッド (System)

が結構便利そうだったので使い方の確認がてらPowerShellでタイトルの処理を作ってみた。

対象のファイル群

Dropboxの自動アップロードによってスマホからPCに同期された画像ファイルに対して処理を行う。

画像ファイルの名前は自動で2018-03-23 12.34.56.jpgといった形式となるため、その名前を日付に変換して分類を行う。

コード

<#
.Synopsis
Dropboxでアップロードされた画像ファイルを日付で分類する
yyMMのフォルダを作成して、その中に移動する
#>

[string]$rootPath = 
    # カレントディレクトリ以下のファイルを対象にする場合
    $PWD.ProviderPath
    # PS1として保存して、その保存先フォルダ内を対象にする場合
    #[IO.Path]::GetDirectoryName($MyInvocation.MyCommand.Definition)

# Dropboxで自動アップロードされたファイルは以下のような名前になる
# e.g. 2018年3月23日12時34分56秒に撮影した画像の場合
# 2018-03-23 12.34.56.jpg
[string]$dateFormat = 'yyyy-MM-dd HH.mm.ss'

# DateTime.TryParseExact の引数指定が面倒だったため、スクリプトブロックに格納
[scriptblock]$tryParse = {
    param([string]$dateString, [ref]$outDate)
    return [datetime]::TryParseExact(
            $dateString, 
            $dateFormat,
            [Globalization.DateTimeFormatInfo]::CurrentInfo,
            [System.Globalization.DateTimeStyles]::None,
            $outDate
        )
}

# パースした結果受け取り用変数
[datetime]$parsedDate = [datetime]::MinValue

# $rootPath 内のファイルに対して操作
Get-ChildItem -LiteralPath $rootPath |
    # 名前を日付に変換できるものだけにフィルター
    ?{$tryParse.Invoke(
        # $_ には [System.IO.FileSystemInfo] が入るはず
        [IO.Path]::GetFileNameWithoutExtension($_.Name),
        [ref]$parsedDate)
    } |

    # 取得した日付を書式設定した値でグループ化(PowerShellのパイプラインの動作上、$parsedDateはちゃんと反映される)
    Group-Object -Property {$parsedDate.ToString('yyMM')} | 

    # 各グループに対して処理
    %{
        # 出力先のフォルダ作成
        # [IO.Directory]::CreateDirectory は冪等性のある処理っぽいのですでに存在していてもOK
        [string]$destDir = [IO.Path]::Combine($rootPath, $_.Name)
        [IO.Directory]::CreateDirectory($destDir) > $null

        # 各ファイルを移動
        $_.Group | 
        %{
            [string]$moveToPath = [IO.Path]::Combine($destDir,$_.Name)
            Write-Host ('{0} => {1}' -f $_.Name, [IO.Path]::GetFileName($destDir))
            $_.MoveTo($moveToPath)
        }
    }

Excelの選択しているセルの行・列に色を付ける(書式を設定する)

Twitterで面白そうなネタを見つけたのでやってみる。

はまさんのツイート: "アクティブセルの行全体に色を付ける方法です。横に長い表の場合は、便利です。 https://t.co/wJr1nNaxxX… "

アクティブセルのある行・列を目立たせる:エクセルマクロ・Excel VBAの使い方-イベントプロシージャ

リンク先の方法は非常にシンプルで良いのですが、直前に触った一つのセルしか対象になりません。

複数セル選択に対応できないかと、いじくり回していたら何とかなったので備忘録として残します。

コード

'Worksheet Module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '条件付き書式で使う数式(常にTrue)
    Const FC_ID = "=ISTEXT(""ID1"")"
    
    '条件付き書式を適用する範囲
    Dim crossRng As Excel.Range
    Set crossRng = Excel.Union(Target.EntireRow, Target.EntireColumn)
    
    '条件付き書式を探す
    Dim fc As Excel.FormatCondition
    If tryGetFmtCond(Me, FC_ID, fc) Then
        
        '条件付き書式の範囲を変更(元に戻すの履歴は消えない)
        Call fc.ModifyAppliesToRange(crossRng)
        
    Else
        
        '見つからなかったので新規作成
        Set fc = crossRng.FormatConditions.Add(xlExpression, Formula1:=FC_ID)
        With fc.Interior
            .Pattern = XlPattern.xlPatternGray25
            .PatternColor = vbYellow
        End With 'fc.Interior
        
    End If
    
End Sub


'`ws`から`condFormula`の数式の条件付き書式を探す。
'見つかったらTrueおよび`oFmtCond`に見つかった条件付き書式を返す。
Private Function tryGetFmtCond( _
    ws As Excel.Worksheet, _
    condFormula As String, _
    ByRef oFmtCond As Excel.FormatCondition) As Boolean
    
    Dim fc As Excel.FormatCondition
    For Each fc In ws.Cells.FormatConditions
        Select Case True
            Case fc.Type <> XlFormatConditionType.xlExpression, _
                 fc.Formula1 <> condFormula
                'Next
                
            Case Else
                Set oFmtCond = fc
                Let tryGetFmtCond = True
                Exit Function
                
        End Select
    Next fc
    
End Function

動作イメージ

やっていること

  1. 常にTRUEの条件付き書式を作成する(常にその範囲に書式が設定される)
  2. 条件付き書式の適用範囲を、選択セルに応じて動的に変更する

余談

FormatConditionModifyAppliesToRangeなど一部のメソッドは、実行しても「元に戻す」の履歴は消えないようです。

問題点

条件付き書式を自己生成するため、止める手段がありません。

アドイン化&クラスモジュール化して、インスタンス・破棄で制御する形にすれば良いですが……

メモ:VBAからDiscordにメッセージを送信する

完全に見様見真似のメモ。

ほぼこちらの内容をVBAにしただけ。

アプリケーションからDiscordのチャンネルにメッセージを送る - Qiita

webhookのURLを取得

この辺から取得する。

設定 > テーマ > 詳細設定 >開発者モード のチェックが必要かも

f:id:imihito:20180127232758p:plain

当然ながら、自分がサーバー権限持ってないと取得できない。

ただ、簡単にサーバーは建てられるので、試すだけだけなら非常に楽。

メッセージ送信

MSXML2.XMLHTTPオブジェクトを作ってPOSTするだけ。

失敗した場合は、sendした後にresponseTextにエラーメッセージが入る。

また、openの第三引数varAsyncにTrueを指定しないと、sendで強制停止させられてエラーになる。

Sub SendDiscordMsgSample()
    
    Dim msg As String
    msg = "Hello Discord!!"
    
    Const WEBHOOK_URL = ' 上記で取得したURL文字列
    Dim xhr As Object 'As MSXML2.XMLHTTP60
    Set xhr = VBA.CreateObject("MSXML2.XMLHTTP")
    
    With xhr
        .open "POST", WEBHOOK_URL, True
        .setRequestHeader "Content-Type", "application/json"
        .send "{""content"":""" & msg & """}"
    End With 'xhr
    
End Sub

結果

f:id:imihito:20180127233503p:plain

参考

公式。ちゃんと理解していない。

Discord - Developer Documentation

メモ:PowerShellのAdd-MemberでCOMオブジェクトを拡張する

PowerShellではAdd-Memberコマンドレットを使って、任意のオブジェクトを拡張することが出来る。

この「任意のオブジェクト」にCOMオブジェクトも含まれていたため、動作確認も含めてメモ。

(Add-MemberそのものについてはAdd-Member を極める - 鷲ノ巣が詳しい)

やること

Scripting.Dictionary に TryGetValueという名前のメソッドを追加する。

VBAで書くと以下のようなイメージ

Private dic As Scripting.Dictionary
'...
Function TryGetValue(Key As Variant, ByRef Value As Variant) As Boolean
    Dim isExist As Boolean
    isExist = dic.Exists(Key)
    
    If isExist Then
        Value = dic.Item(Key) 'TODO:Value / Object
    End If
    
    Let TryGetValue = isExist
End Function

PowerShellのコード

# 拡張したCOMオブジェクトを取得する
       # Scripting.Dictionaryをインスタンスして次へ流す
$dic = New-Object -ComObject Scripting.Dictionary |
        # TryGetValue という名前のメソッドを追加
        Add-Member -Name TryGetValue -MemberType ScriptMethod -Value {
            # 引数の設定
            param ([object]$Key, [ref]$Value)

            [bool]$exist? = $this.Exists($Key)
            if ($exist?) {
                $Value.Value = $this.Item($Key)
            }
            Write-Output $exist?
        } -PassThru # 拡張されたオブジェクトを出力

# 準備
$dic.Add('dog', '犬')
$dic.Add('cat', '猫')

# 通常の参照
Write-Host 通常: $dic.Item('dog') # => 通常: 犬

# TryGetValueの動作確認
foreach ($k in @('dog', 'cat','mouse')) {
    $val = ''
    if ($dic.TryGetValue($k, [ref]$val)) {
        Write-Host $k は存在する 値: $val
    } else {
        Write-Host $k は存在しない
    }
}
<#
dog は存在する 値: 犬
cat は存在する 値: 猫
mouse は存在しない
#>

XML生成の練習

やること

以下のXML(HTML)を、PowerShellを使って生成してみる。

<html lang="ja">
  <head>
    <meta charset="utf-8" />
  </head>
  <body>
    <p>Hello <strong>W</strong>orld !!<br />made by PowerShell</p>
  </body>
</html>

f:id:imihito:20180120224636p:plain
生成htmlイメージ

(HTMLとして考えると<!DOCTYPE html>も必要だが後で何とかなるので置いておく)

操作方法の確認も兼ねて以下の二つの方法で作成してみる。

  • System.Xml.XmlWriterを使用する
  • System.Xml.XmlDocumentを使用する

System.Xml.XmlWriter

基本的にWriteStart○○メソッドで要素を書き出して、WriteEnd○○で閉じる。 閉じてない要素は最後で自動で閉じてくれるので省略可。

要素と中身が固定(追記が必要ない)場合はWrite○○Stringを使うと一行で済んで楽になる。

# XML書き出し先
[Text.StringBuilder]$sb = New-Object -TypeName Text.StringBuilder

# XmlWriter設定項目 インスタンス&プロパティ設定
[Xml.XmlWriterSettings]$setXw = 
    New-Object -TypeName Xml.XmlWriterSettings -Property @{
            OmitXmlDeclaration = $true #<?xml version="1.0"~を作成しない
            Indent             = $true #自動整形する
        }

[Xml.XmlWriter]$xw = [Xml.XmlWriter]::Create($sb, $setXw)

# htmlタグ
$xw.WriteStartElement("html")
$xw.WriteAttributeString("lang", "ja")
    
    # headタグ
    $xw.WriteStartElement("head")
        
        $xw.WriteStartElement("meta")
            $xw.WriteAttributeString("charset", "utf-8")
        $xw.WriteEndElement()

    $xw.WriteEndElement()

    # bodyタグ
    $xw.WriteStartElement("body")
        
        $xw.WriteStartElement("p")
            $xw.WriteString("Hello ")
            $xw.WriteElementString("strong", "W")
            $xw.WriteString("orld !!")

            $xw.WriteElementString("br", $null)
            $xw.WriteString("made by PowerShell")


$xw.Close() # 自動タグ閉じ

# 結果確認
$sb.ToString()

# ファイル出力
<#
[string]$savePath = [IO.Path]::Combine(
        [Environment]::GetFolderPath("MyDocuments"),
        "XmlWriter.html"
    )

[IO.File]::WriteAllText(
    $savePath,
    $sb.ToString(),
    [Text.UTF8Encoding]$false
)

explorer.exe $savePath
#>

System.Xml.XmlDocument

Xml.XmlDocumentCreateElementメソッドで要素を作成し、それを各要素にAppendChildで追加していく。

各要素がオブジェクトとして返るので、その分変数が必要。

# 文字列をXml.XmlDocument型にキャスト(型エイリアス[xml])
[xml]$doc = [xml]"<html />"

# htmlタグ
[Xml.XmlNode]$ndHtml = $doc.FirstChild
$ndHtml.SetAttribute("lang", "ja")

# headタグ
[Xml.XmlNode]$ndHead = $ndHtml.AppendChild($doc.CreateElement("head"))
    
    $ndHead.AppendChild(
        $doc.CreateElement("meta")
    ).SetAttribute("charset", "utf-8")

# bodyタグ
[Xml.XmlNode]$ndBody = $ndHtml.AppendChild($doc.CreateElement("body"))

    [Xml.XmlNode]$ndP = $ndBody.AppendChild($doc.CreateElement("p"))
        $ndP.AppendChild($doc.CreateTextNode("Hello ")) > $null
        $ndP.AppendChild($doc.CreateElement("strong")).InnerText = "W"
        $ndP.AppendChild($doc.CreateTextNode("orld !!")) > $null
        
        $ndP.AppendChild($doc.CreateElement("br")) > $null
        $ndP.AppendChild($doc.CreateTextNode("made by PowerShell")) > $null


# 出力準備
[Text.StringBuilder]$sb = New-Object -TypeName Text.StringBuilder
[Xml.XmlWriterSettings]$setXw = 
    New-Object -TypeName Xml.XmlWriterSettings -Property @{
            OmitXmlDeclaration = $true #<?xml version="1.0"~を作成しない
            Indent             = $true #自動整形する
        }

$doc.Save([Xml.XmlWriter]::Create($sb, $setXw))

# 結果確認
$sb.ToString()

# ファイル出力
<#
[string]$savePath = [IO.Path]::Combine(
        [Environment]::GetFolderPath("MyDocuments"),
        "XmlDocument.html"
    )

[IO.File]::WriteAllText(
    $savePath,
    $sb.ToString(),
    [Text.UTF8Encoding]$false
)

explorer.exe $savePath
#>

感想

今回の例のように純粋に生成するだけならXml.XmlWriterを使った方が楽そう。

.NET系だと LINQ to XML を使う方法があるらしいけど、なかなか使う機会が無いので一旦スルー。

メモ:PowerShellで画像をリサイズする

PowerShellを使って画像ファイルを縮小保存する方法のメモ

Bitmap クラス (System.Drawing)

として画像を取り込んだ後、

Bitmap コンストラクター (Image, Int32, Int32) (System.Drawing)

で新しい大きさで画像を作成して保存する。

実際のコード

処理上の決め打ちとして、縦横それぞれ半分($Scale = 0.5)にして「マイピクチャ」にJpegで保存している。

Add-Type -AssemblyName System.Drawing

<#
.Synopsis
画像をリサイズしてマイピクチャにJpegで保存する
#>

# 元の画像ファイル
[string]$Path = "C:\hoge.png"

# 変換サイズ
[double]$Scale = 0.5

# 保存形式
[Drawing.Imaging.ImageFormat]$OutFormat = [Drawing.Imaging.ImageFormat]::Jpeg


# ファイルから画像を読み込み([Drawing.Image]の方が良いけど手抜き)
[Drawing.Bitmap]$srcBmp = [Drawing.Bitmap]::FromFile( $Path )

# 新しい画像サイズ
[int]$newWidth  = $srcBmp.Width  * $Scale
[int]$newHeight = $srcBmp.Height * $Scale

# リサイズした画像
[Drawing.Bitmap]$destBmp = 
    New-Object -TypeName Drawing.Bitmap -ArgumentList $srcBmp, $newWidth, $newHeight

# 出力先のパス
[string]$destPath = 
    [IO.Path]::Combine(
        # 親フォルダ
        [Environment]::GetFolderPath([Environment+SpecialFolder]::MyPictures), 
        
        # 拡張子変更
        [IO.Path]::ChangeExtension(
            [IO.Path]::GetFileName($Path), 
            $OutFormat.ToString()
        )   
    )

# 形式指定で保存(既存ファイル上書き)
$destBmp.Save($destPath, $OutFormat)

# 結果確認
Write-Host 保存先は「 $destPath 」です。

上記コードはPowerShellの特徴であるパイプや自動型変換を使うと、以下のようにも書ける。

Add-Type -AssemblyName System.Drawing

<#
.Synopsis
画像をリサイズしてマイピクチャにJpegで保存する
#>

# 元の画像ファイル
$Path = "C:\hoge.png"

# 変換サイズ
$Scale = 0.5

# 保存形式
$OutFormat = "Jpeg"

$Path | %{
        ([Drawing.Bitmap]$_ | 
                %{New-Object -TypeName Drawing.Bitmap -ArgumentList $_, ([int]($_.Width * $Scale)), ([int]($_.Height * $Scale))}
            ).Save([IO.Path]::Combine(
                [Environment]::GetFolderPath("MyPictures"),
                [IO.Path]::ChangeExtension([IO.Path]::GetFileName($_), $OutFormat)   
            ), $OutFormat)
    }

D&Dでつかるようにする

前項のコードは動作確認にはいいけれど、実際には使いにくいのでドラッグ&ドロップで実行できるようにしてみる。

PowerShellのファイルは通常ドロップを受け付けないため、起動用のバッチファイルと本体のスクリプトの2ファイルを用意する。

PowerShell

以下のコードをps1ファイルとして保存する(文字コードを考えるとPowerShell ISEなど経由で保存の方が良いかも)

<#
.Synopsis
画像をリサイズしてマイピクチャにJpegで保存する
#>

if($args.Length -eq 0) {
    explorer.exe ([Environment]::GetFolderPath("SendTo"))
    exit
}

[string[]]$Path = $args

Add-Type -AssemblyName System.Drawing

# 変換サイズ
[double]$Scale = 0.5
# 保存形式
[Drawing.Imaging.ImageFormat]$OutFormat = [Drawing.Imaging.ImageFormat]::Jpeg

Set-StrictMode -Version Latest
$Path | %{
        ([Drawing.Bitmap]$_ | 
                %{New-Object -TypeName Drawing.Bitmap -ArgumentList $_, ([int]($_.Width * $Scale)), ([int]($_.Height * $Scale))}
            ).Save([IO.Path]::Combine(
                [Environment]::GetFolderPath("MyPictures"),
                [IO.Path]::ChangeExtension([IO.Path]::GetFileName($_), $OutFormat)   
            ), $OutFormat)
    }
explorer.exe ([Environment]::GetFolderPath("MyPictures"))

バッチ

上記ps1ファイルと同じ場所、同じ名前で以下のbatファイルを作成する。

@Powershell -ExecutionPolicy RemoteSigned -File "%~dpn0.ps1" %*

あとはbatファイルに画像ファイルをドロップすればファイルが変換される。

ただし、PowerShellの起動時間が1秒ぐらいかかるので、ちゃっちゃとやりたい場合はC#とかで作ってください。

VBA ListRowを使いやすくするクラス

はじめに

ListRow オブジェクト (Excel)Excelのテーブルの行を表すオブジェクトです。

自分のテーブル(ListObject)の使い方

ワークシート関数のVLOOKUPのようなことをマクロから行うことが多いです。

単純な検索であればVLOOKUPやMATCH+INDEX関数で大丈夫ですが、 複数の列から同時に情報を取得したい、検索条件を柔軟にしたいと言った理由からマクロを使っています。

以上のような操作を行う場合

まずは以下のように対象の列の値の範囲を取得し、検索値がどの行にあるのかを探します。

ListObject.ListColumns.Item(検索する値の列見出し).DataBodyRange
'検索処理...

行番号が見つかったら、以下のように値を取得していきます。

ListObject.ListColumns.Item(取得したい見出し1).DataBodyRange.Item(行番号).Value()
ListObject.ListColumns.Item(取得したい見出し2).DataBodyRange.Item(行番号).Value()
'…

…はい、やけに長ったらしくなりますね。

Withを使えば多少は短くなりますが、ListColumns.Item().DataBodyRange.Item()と結構深く掘る必要があるのが面倒です。

またListColumnと対をなすListRowの方では列見出しから値を取得するすることができません。

ならばListRowから列見出しで値を取得できるようにすればいいじゃないか? という事でそのためのクラスを作成しました。

クラス本体

以下のコードをListRow2という名前のクラスモジュールに貼り付けてください。

Option Explicit

Implements Excel.ListRow
Public Base As Excel.ListRow

'列の番号or見出しから該当するセルを取得する
Function Item(Index As Variant) As Excel.Range
'Attribute Item.VB_UserMemId = 0
    Set Item = getItem(Me, Index)
End Function

Private Function getItem(this As ListRow2, Index As Variant) As Excel.Range
    Set getItem = this.Parent.ListColumns.Item(Index).DataBodyRange.Item(this.Index)
End Function


'以下は既存のメンバーのラップ用
Private Sub ListRow_Delete():   Call Base.Delete: End Sub
        Sub Delete():           Call Base.Delete: End Sub

Private Property Get ListRow_Application() As Application:  Set ListRow_Application = Base.Application: End Property
        Property Get Application() As Excel.Application:    Set Application = Base.Application:         End Property

Private Property Get ListRow_Creator() As XlCreator:        Let ListRow_Creator = Base.Creator:         End Property
        Property Get Creator() As Excel.XlCreator:          Let Creator = Base.Creator:                 End Property

Private Property Get ListRow_Index() As Long:               Let ListRow_Index = Base.Index:             End Property
        Property Get Index() As Long:                       Let Index = Base.Index:                     End Property

Private Property Get ListRow_InvalidData() As Boolean:      Let ListRow_InvalidData = Base.InvalidData: End Property
        Property Get InvalidData() As Boolean:              Let InvalidData = Base.InvalidData:         End Property

Private Property Get ListRow_Parent() As Object:            Set ListRow_Parent = Base.Parent:           End Property
        Property Get Parent() As Excel.ListObject:          Set Parent = Base.Parent:                   End Property

Private Property Get ListRow_Range() As Range:              Set ListRow_Range = Base.Range:             End Property
        Property Get Range() As Excel.Range:                Set Range = Base.Range:                     End Property

使用例

新規ブックに以下のコードと上記のクラスを貼り付けて実行してみてください(既存のブックだと一枚目のワークシートが強制的に書き換えられます)。

なお、コード中で作成しているテーブルの中身は以下の記事を参考に作成しています。

VBA クラスモジュールでExcelのテーブル(ListObject)を操作する - t-hom’s diary

Sub SampleListRow2()
    
    Dim ws As Excel.Worksheet
    Set ws = Excel.ThisWorkbook.Worksheets.Item(1)
    
'テーブルの準備
    'テーブルの中身。配列定数をEvaluate
    tableData = [{"果物","いちご","150";"果物","ばなな","100";"果物","りんご","200";"野菜","キャベツ","150";"野菜","なすび","100";"野菜","レタス","120";"肉","牛肉","300";"肉","豚肉","200";"肉","鶏肉","100"}]
    
    ws.UsedRange.Clear
    With ws.Range("A1").Resize(UBound(tableData, 1), UBound(tableData, 2))
        .Value() = tableData
        
        Dim table As Excel.ListObject
        Set table = ws.ListObjects.Add(xlSrcRange, .Cells)
        
    End With 'ws.Range("A1").Resize(UBound(tableData, 1), UBound(tableData, 2))
    
    With table
        .ShowHeaders = True
        .HeaderRowRange.Value() = VBA.Split("種目,品名,価格", ",")
    End With 'table
    
    
'検索して値の取得
    'りんごについて、種目と価格を知りたい場合
    Dim nameCol As Excel.ListColumn
    Set nameCol = table.ListColumns.Item("品名")
    
    'Matchで手抜き検索
    Dim appleIndex As Long
    appleIndex = Excel.WorksheetFunction.Match("りんご", nameCol.DataBodyRange, 0)
    
    
    '通常の場合
    With table.ListColumns
        Debug.Print "種目", .Item("種目").DataBodyRange.Item(appleIndex).Text '←最後でインテリセンスが切れる
        Debug.Print "価格", .Item("価格").DataBodyRange.Item(appleIndex).Value()
    End With
    
    '自作クラスを使った場合
    Dim appleRow As ListRow2
    Set appleRow = New ListRow2
    Set appleRow.Base = table.ListRows.Item(appleIndex)
    
    Debug.Print "種目", appleRow.Item("種目").Text '←最後までインテリセンスが効く
    Debug.Print "価格", appleRow.Item("価格").Value()
    
    Stop
    
End Sub

その他

Excel.ListRowをImplementsできたのでクラス化しましたが、getItemだけを関数にしてもいい気がします。

こういった「既存のクラスを拡張したい」時に .NET Frameworkの拡張メソッドがうらやましくなります。