Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。JavaScriptやJScript,HTAに最近はまってます。

mp3ファイルをbase64でテキストにしてjavascriptで活用する

すっかりHTAにはまりこんで,Powerpointに戻る気配がありません(;´∀`)

JavascriptCSS,HTML5でできることの幅広さにおののく毎日で,日々本がたまりにたまって読める気配がない。

でも,気の向くままに,調べものするときに読むことで,少しずつ,少しずつ頭の中に概念みたいなものができつつある気がします。

読みながらやれば大概なんとかなりそうな感じです。

さて,HTAの数少ない不満は 画像や音声ファイルを別ファイルで用意しないといけない,という不満でした。

依存ファイルがあると,作って時間がたつと忘れてしまうし,もし誰かに欲しいといわれたときに提供したとして,前提条件が崩れるとうまく動かなくなるのは容易に予測できる。

jQueryやグラフのライブラリはいくらかあきらめがつきますし,私が使う棒グラフ・円グラフくらいならSVGCanvasでどうにかすればいい話だよなぁとも思う。

Illustratorもあるので,画像データはけっこうSVGにできますし,CSSがやれることも半端ない。

画像面ではほぼ問題は見当たりません。

でも,音源ファイルがどうにかならないのかなーと調べていたら,Base64エンコードすることで解決しそうでした。

こちらの記事のおかげです。

qiita.com

そこで,mp3ファイルをWindowsのcertutilコマンドでエンコードするものをexcelvbaで組んでみました。

フォルダを指定して,その直下のmp3ファイルをエンコードします。

そして,さらにそれにちょっとhtmlを足して,htmファイルにして音を確認する感じに作ってみました。

完全に自分用(ノ´∀`*)

前者がこんな感じ

Sub base64encode()
    Dim strPathName As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            strPathName = .SelectedItems(1)
        End If
    End With
    
    If strPathName = "" Then Exit Sub
    
    Dim strFileName As String
    
    strFileName = Dir(strPathName & "\*.mp3", vbNormal)
    If strFileName = "" Then Exit Sub
    Do While strFileName <> ""
        DoEvents
        Shell "certutil -f -encode " & strPathName & "\" & strFileName & " " & strPathName & "\" & Left(strFileName, InStr(strFileName, ".mp3") - 1) & ".htm"
        strFileName = Dir()
    Loop
End Sub

とても短いです(;´∀`)でもこれでhtmファイルを吐き出します。
ただこのままではどんな音だったか確認もできないので,それにちょっと編集をするのが次のコード

Sub edittext()
    Dim strPathName As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            strPathName = .SelectedItems(1)
        End If
    End With
    
    If strPathName = "" Then Exit Sub
    
    Dim strFileName As String

    strFileName = Dir(strPathName & "\*.htm", vbNormal)
    Dim inputText, outputText, records, lineStr, flg As Boolean
    
    
    Do While strFileName <> ""
        DoEvents
        Set inputText = CreateObject("ADODB.Stream")
        With inputText
            .Charset = "UTF-8"
            .Mode = 3 '読み書き
            .Type = 2 'テキスト
            .Open
            .LoadFromFile strPathName & "\" & strFileName
        End With
        
        Set outputText = CreateObject("ADODB.Stream")
        With outputText
            .Charset = "UTF-8"
            .Mode = 3 '読み書き
            .Type = 2 'テキスト
            .Open
            .writetext "<audio controls='controls' autoplay style='border:3px solid red;'><source src='data:audio/mp3;base64,", 1
            flg = True
            Do Until inputText.eos
                DoEvents
                lineStr = inputText.readtext(-2)
                If flg = True Then
                    flg = False
                Else
                    .writetext Replace(lineStr, vbCrLf, ""), 0 '問題あったら1
                End If
            Loop
            .writetext "", 1
            .writetext "' type='audio/mp3' /></audio>", 0
            .savetofile strPathName & "\" & strFileName, 2
            .Close
        End With
        strFileName = Dir()
    Loop
End Sub

この二つをつなげるとうまくいかなかったので,タイミングを分ける意味で分割しています。
さっきのコードで吐き出したhtmファイルにaudioタグを付け加えることで,

そのhtmを開くと音を鳴らすようにしただけです。

あと,base64で吐き出したものを一行にするように少し細工をしています。

これで一応文字列にはなりました。

今度はjavascriptでうまく使えるように調整をしていこう。

<meta http-equiv="X-UA-Compatible" content="IE=edge" charset="utf-8">

この一文を頭に付け加えるだけで,htaにしてもきちんと動くようです。

htaの制限ってあんまりないのかな・・と最近思います。

このブログの名前の変更を検討するべきなんだろうか・・(;´∀`)