VBAのMSGBOXのアイコンを用意する

VBAのMsgBoxを自作する上で困るのはアイコンです。
あ、「いきなりなんだよ」と思った方はこちらからどうぞ。

https://minimashia.net/vba-msgbox-create-reason

2012.12.28

VBAを使ったことがある人ならきっと誰でも使ったことがあるMsgBox関数。その名の通りメッセージボックスを表示するための関数ですが、これを自作しました。たった1行の処理を自作すると丸1日かかるんですね…という泣き言はともかく、あれこれ困った話。メリット Timerさんと喧嘩するから Timerで登録した時間に～～する、という処理を実装したんですが、このTimerさんは標準ダイアログ(MsgBoxや印刷プレビュー、ページ設定など)を開いていると指定の時間になっても起爆しないという仕様みたいです。もちろん指定の時間から数分経過し...

MsgBoxは引数によって4種類(情報、警告、問い合わせ、注意)のアイコンを表示します。
ですが、いくらVBA上とはいえ勝手に使っていいものなのか？？
ていうかそもそもMsgBoxを使わないならどこからこのアイコン取ってくれば？？
調べてもわからないというか、望み薄そうだったので、大して調べずに商業用もOKのフリー素材からよく似たものを貰って来ました。

次にこのアイコンをどこに保持していようか、です。
自分がローカルで使うなら構いませんが、これはお仕事。ばら撒かれるソフトです。
しかもExcelファイル1ファイルをぺろっとばら撒きたいという前提です。
そこで、隠しシートにアイコンを設置しておき、起動時にキャプチャをとって隠しディレクトリに出力するって方法をとっていました。

みにましあ

https://minimashia.net/vba-img-output

2012.12.28

VBAでExcel内の画像を出力する

Excel内の画像をVBAから出力する方法です。冒頭からなんですが、ちょっと問題があるので注意が必要です。（jpegに保存するため）画質が少々劣化する＆透過画像はつくれないごく稀に出力されずに真っ白のアイコンになってしまう背景も一緒に画像化するので、必要ならセルを都合の良い色で染めておく必要があるDim shps As Shapes: Set shps = Table_Icons.ShapesDim shp As ShapeDim area As ObjectFor Each shp In shps If shp.Type = msoPicture Then Set area = Intersect(Range(shp.TopLeftCell, shp.BottomRightCell...

が、これだと問題があって、

（jpegに保存するため）画質が少々劣化する
ごく稀に出力されずに真っ白のアイコンになってしまう

なので、あまり大きな画像ではありませんし、隠しシート（Table_Icons）の4列にバイナリデータを列挙しておいて、これを画像ファイルとして隠しディレクトリに出力するようにしました。
呼び出し元はThisWorkbook.Workbook_Openです。

'　nCol          アイコンのバイナリ情報が格納されている列
'　strFileName   エクスポートする際のファイル名
Private Sub ExportIcon(nCol As Long, strFileName As String)
    Dim nRow As Long: nRow = 1
    Dim nFileNo As Long: nFileNo = FreeFile

    ' バイナリモードで開く
    Open "隠しディレクトリパス" & "\" & strFileName For Binary As #nFileNo
        ' データを書き出し
        Do While 1 <= Len(Table_Icons.Cells(nRow, nCol).value)
            Put #nFileNo, , CByte(Table_Icons.Cells(nRow, nCol).value)
            nRow = nRow + 1
        Loop
    ' 保存
    Close #nFileNo
End Sub

ThisWorkbook.Workbook_BeforeCloseで隠しディレクトリの削除も忘れずに。

他にもニッチなIT関連要素をまとめていますので、よければ一覧記事もご覧ください。

みにましあ

https://minimashia.net/it-tips

2019.12.04