Launchy を利用して素早く新規ファイルを作成したい【Windows】【VBScript】

はじめに

　macOS には Spotlight がありますが、Windows には無いので代わりに Launchy を使っています。先日作ったものを Windows 用にも作ってみました。

　現在、Windows が手元にないので動作未検証です。そのうち検証します。

【追記(2022/06/26)：エクスプローラーの「最前面ウィンドウ」が取得できませんでした。ひとまず断念。折を見てまた挑戦します】

BeBox Re:ゼロから始める異世界生活 レム ~ Qilolita 1/7スケール PVC・ABS製 塗装済み 完成品 フィギュア

VBScript でできるか

仕様

1. 新規ファイルを作成する場所は、エクスプローラーで今開いている場所。なければデスクトップ。
2. ファイル名は、デフォルトで日付文字列 + 拡張子。
3. ファイル作成後は、すぐにファイル名の変更ができるように、エクスプローラーで選択状態にする。

インストール

　以下のソースコードを拡張子 ".vbs" で保存し、Launchy で開けるようにしておきます。

　ファイル名は "nm新規マークダウン書類newmarkdown.vbs" のような名前で良いでしょう。

Option Explicit

Private Const EXTENSION = ".md"

' ---
' エクスプローラーで開いているフォルダのパスを取得する。
' 取得できなければ、デスクトップフォルダのパスを取得する。
' 参考：
'   https://r2z.hateblo.jp/entry/20100731/p1
'   https://www.ka-net.org/blog/?p=3782
' ---
Dim shell, fso
Set shell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

Dim path
path = ""
Do
    Dim wnd
    For Each wnd In shell.Windows
        If InStr(TypeName(wnd.document), "IShellFolderViewDual") >= 0 Then
            ' エスクプローラーウィンドウならパスを取得する
            path = wnd.Document.Folder.Self.Path
            Exit For
        End If
    Next
    Exit Do
Loop

If path = "" Then
    ' ウィンドウを開いていなければ、デスクトップのパスを取得する
    Private Const SSFC_DESKTOP_DIRECTORY = 16
    path = shell.Namespace(SSFC_DESKTOP_DIRECTORY).Self.Path
End If
Set shell = Nothing

' ---
' 日付文字列のファイル名を作成する
' ---
Dim fileName
fileName = Year(Now) & "-" & _
    Right("00" & Month(Now), 2) & "-" & _
    Right("00" & Day(Now), 2)

Dim fullName
fullName = path & "\" & fileName & EXTENSION

' ---
' フルパスを作成する
' ---
Dim seq
seq = 1
Do
    If fso.FileExists(fullName) Then
        fullName = path & "\" & fileName & "-" & seq & EXTENSION
        seq = seq + 1
    Else
        Exit Do
    End If
Loop

' ---
' ファイルを作成する
' ---
Dim fileH
Private Const FOR_WRITING = 2
Private Const CREATE_FILE = True
Set fileH = fso.OpenTextFile(fullName, FOR_WRITING, CREATE_FILE)
fileH.Close
Set fileH = Nothing
Set fso = Nothing

' ---
' エクスプローラーで選択状態にする
' ---
Dim wsh
Set wsh = CreateObject("WScript.Shell")
wsh.Run "explorer.exe /select, """ & fullName & """"
Set wsh = Nothing

さいごに

　Launchy には ".lnk" ファイルをカタログするようにしておいて、ショートカットのプロパティで拡張子を起動オプションにすれば、".txt" もほとんど同じコードでいけるかと思います。

『きみに出会うとき』レベッカ=ステッド著 東京創元社

きみに出会うとき

「そうだねえ、だれかを愛するのはかんたんなことだよ。でも、それを声に出して言うべきときはいつなのか、それを見きわめるのがむずかしいね」

Excel のスクリーンショット機能で Edge のウィンドウを選ぶと真っ黒になる 【VBA】【Windows】

はじめに

　この記事の内容は、Windows 専用です。macOS の Excel を持っていないため、同様の不具合が発生しているのか、そもそも確認できていません。

天官賜福 謝怜 太子悅神Ver. 1/7スケール ABS&PVC製 塗装済み完成品フィギュア 二次受注分

問題

　Google 検索 で「excel スクリーンショット edge」と入力すると「真っ黒」というサジェストが出ます。そこそこ困っている人が多いようです。

　これはセキュリティのためですが、Edge の画面をスクリーンショットに撮って Excel に貼り付けるという要件は少なくありません。

　Excel にはスクリーンショットを簡単に挿入する機能がありますが、一部のアプリ、例えば Web ブラウザの Microsoft Edge などでは、その機能を使うと真っ黒のイメージが貼り付けられます。使えません。他の手段でスクリーンショットを撮ることはできるのですが、手順が多くて面倒です。

他の手段でスクリーンショットを撮る

　他の手段は、以下の通りです。

1. Edge をアクティブにする
2. Alt + PrintScreen キーを押す（スクリーンショットイメージがクリップボードに入る）
3. Excel に戻る
4. Ctrl + V キーを押す（ペースト）

VBA で解決

　以上の手順を、VBA で自動実行するようにします。

　「個人用マクロブック」に「標準モジュール」を追加して、以下のコードを貼り付けてください。

　部分的に赤字になるかもしれませんが、大丈夫、実行できます。

Optional Explicit

Private ws As Worksheet

#If Win64 Then
    ' 64bit 用
    Private Declare PrtSafe Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwFlags As Long, _
        ByVal dwExtraInfo As Long _
            )
    Private Declare PrtSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    ' 32bit 用
    Private Declare Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwFlags As Long, _
        ByVal dwExtraInfo As Long _
            )
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Public Sub アクティブ画面を撮って貼付ける()
    On Error GoTo ERR_EXIT
    Set ws = ActiveSheet
    Application.Visible = False
    Application.OnTime Now + TimeValue("00:00:01"), "PrintScreenActiveWindowAndPaste"
    ' 少し待っているのは、Excel を非表示にした瞬間に Tooltip などが残る可能性があるため。
ERR_EXIT:
    Application.Visible = True
End Sub

Private Sub PrintScreenActiveWindow()
    keybd_event &HA4, 0&, &H1, 0&
    keybd_event vbKeySnapshot, 0&, &H1, 0&
    keybd_event vbKeySnapshot, 0&, &H1 Or &H2, 0&
    keybd_event &HA4, 0&, &H1 Or &H2, 0&
End Sub

Private Sub PrintScreenActiveWindowAndPaste()
    PrintScreenActiveWindow
    DoEvents
    Sleep 75
    DoEvents
    Application.Visible = True
    ws.Activate
    Set ws = Nothing
    ActiveSheet.Paste
End Sub

リボンに登録する

　上記で作成したマクロをリボンに登録します。登録するマクロは「アクティブ画面を撮って貼付ける」です。

マクロの使い方

　設定は以上です。リボンに追加したボタンをクリックすると、マクロが実行されます。

　マクロは以下のように動作します。

1. Excel を非表示にする
2. Alt + PrintScreen キーを押す（のと同じことをマクロでやる）
3. Excel に戻る
4. 現在のシートにペーストする

　したがって、Excel が非表示になったときに Edge が最前面になっていれば、期待通りスクリーンショットが撮れます。

注意点

• クリップボードを経由するため、内容を書き換えます
• Excel が非表示になったときに Edge が最前面に来るように作業してください
• Edge 以外でも使えます

Excel VBAの教科書 [ 古川 順平 ]

このブログに貼り付けてあるソースコードについて

基本

　基本、パブリックドメインです。

このブログに貼り付けてあるソースコードについて

　本ブログに貼り付けてあるものは、ソースコードというよりはスニペットだと思っていますので、どうぞご自由にお使いください。

　異なるライセンスにしたいものは別途記載します。ライセンス表記の無いものはパブリックドメインです。GitHub などにアップしてあるものは、そちらにライセンスを記載します。

Google の 20% ルールはすべての企業で採用したほうがいい

はじめに

　まず Google¹ の 20% ルールとは何かを簡単に説明します。

　それは、就業時間の少なくとも 20% を、通常従事しているプロジェクトとは別に、すぐには見返りが期待できなくても、将来大きなチャンスになるかもしれないことに使用するというものです。

　もっと細かいところはきっとあると思いますが、簡単にいうとそれだけのシンプルなものです。

https://www.lifehacker.jp/2020/11/223428google-says-it-still-uses-20-percent-rule-you-should-totally-copy-it.html

　サポンテは、このルールをすべての企業（あるいは、ほとんど多くの企業）が採用すべきと考えます。それは Google のように「クリエイティブに、イノベーティブになる」ためというより、もっと現実的な動機によるものです。

Re:ゼロから始める異世界生活 レム -漢服- 1/7スケールフィギュア 塗装済み 完成品フィギュア

---

1. 正確には親会社の Alphabet。↩

ティーン向けファッション誌の主題は『憧れ』

はじめに

　以下のニュースがありました。

やせて色白のモデルに傷つき…ティーン向けファッション誌は「ありのままで美しいと発信を」元愛読者らがネット署名：東京新聞 TOKYO Web

　見た目に優劣はなく、ありのままで美しいと発信することを求めます！　１０代前半の女子に人気のファッション誌に宛てて、こんなメッセージを送ろうという署名運動がインターネット上で広がっている。

　確かに「色白痩身」が過度に偏重されている風潮はあり、そのこと自体はサポンテも問題であると考えます。

　しかしながら、いささかツッコミどころもあるように感じられます。

ニコラのおゆるり魔界紀行　4 (HARTA COMIX)

AppleScript の do shell script で実行されるシェル環境を調べる

　昨日のスクリプトを作っているときに気になったので。

　スクリプトエディタ.app で以下の AppleScript を実行します。

-- 使われているシェルとそのバージョン取得
set shName to do shell script "echo $SHELL"
log (do shell script shName & " --version")

-- 環境変数の取得
log (do shell script "set")

-- AppleScript のバージョン取得
log ("AppleScript version: " & version of AppleScript)

-- macOS のバージョン取得
log (do shell script "sw_vers")

アイドルマスター シンデレラガールズ 鷺沢文香 ブライトメモリーズVer. 1/7 完成品フィギュア