画像ファイルを名前の日付で分類（DateTime.TryParseExact の使い方メモ）
が結構便利そうだったので使い方の確認がてら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… "
リンク先の方法は非常にシンプルで良いのですが、直前に触った一つのセルしか対象になりません。
複数セル選択に対応できないかと、いじくり回していたら何とかなったので備忘録として残します。
コード
'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
動作イメージ
— いみひと (@nukie_53) 2018年2月22日
やっていること
- 常にTRUEの条件付き書式を作成する（常にその範囲に書式が設定される）
- 条件付き書式の適用範囲を、選択セルに応じて動的に変更する
余談
FormatConditionのModifyAppliesToRangeなど一部のメソッドは、実行しても「元に戻す」の履歴は消えないようです。
問題点
条件付き書式を自己生成するため、止める手段がありません。
アドイン化＆クラスモジュール化して、インスタンス・破棄で制御する形にすれば良いですが……
メモ：VBAからDiscordにメッセージを送信する
完全に見様見真似のメモ。
ほぼこちらの内容をVBAにしただけ。
webhookのURLを取得
この辺から取得する。
設定 > テーマ > 詳細設定 >開発者モード のチェックが必要かも
当然ながら、自分がサーバー権限持ってないと取得できない。
ただ、簡単にサーバーは建てられるので、試すだけだけなら非常に楽。
メッセージ送信
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
結果
参考
公式。ちゃんと理解していない。
メモ：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>
（HTMLとして考えると<!DOCTYPE html>も必要だが後で何とかなるので置いておく）
操作方法の確認も兼ねて以下の二つの方法で作成してみる。
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.XmlDocumentのCreateElementメソッドで要素を作成し、それを各要素に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を使った方が楽そう。
メモ：PowerShellで画像をリサイズする
PowerShellを使って画像ファイルを縮小保存する方法のメモ
として画像を取り込んだ後、
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
使用例
新規ブックに以下のコードと上記のクラスを貼り付けて実行してみてください（既存のブックだと一枚目のワークシートが強制的に書き換えられます）。
なお、コード中で作成しているテーブルの中身は以下の記事を参考に作成しています。
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の拡張メソッドがうらやましくなります。
