読者です 読者をやめる 読者になる 読者になる

B-Teck!

お仕事からゲームまで幅広く

【VBA】パスワードのかかっていないExcelだけ開く

VBAからパスワードのかかったExcelファイルを開く際、普通にWorkbooks.Openするとパスワード入力ダイアログで止まってしまう。
この場合、パスワードを入力するかダイアログを閉じるまで実行中の処理が停止してしまう。
また、ダイアログを閉じた場合にはエラーが発生してしまう。

とりあえず下記方法で回避することができる

  • On Error Resume Nextでエラー発生時に後続の処理が実行されるようにする
  • Open時のパスワード引数に空文字「""」を指定する
  • Open後、Err.NumberがOpen失敗「1004」であるかを確認する
    ※ ループ等の場合、Err.Clearをしないとエラー情報が残ってしまうので注意

ただ少し問題があって、この方法では、パスワードのかかったExcel以外にも開けないExcelが存在したとき(編集中等)に同様に開けないファイルとして扱ってしまう。
どうするのがベストなんだろう。

Sub openExcel(ByVal filePath As String)
    Dim wkBook      As Workbook: Set wkBook = Nothing
    Dim xlApp       As Object: Set xlApp = CreateObject("Excel.Application")
    
'Errorを無視
On Error Resume Next

    'パスワードに空文字を入れることで、パスワード無しで開けるブックのみ開く
    Set wkBook = xlApp.Workbooks.Open(filePath, Password:="")
    'オープン失敗時はエラーメッセージ
    Select Case Err.Number
        Case 1004
            MsgBox "ワークブックにパスワードがかかっているためOpenできません。"
            Err.Clear
        Case 0
            MsgBox filePath & "をOpenしました。"
    End Select
    
    '後処理
    xlApp.Close
    Set xlApp = Nothing
End Sub

【VBA】配列をソートする

'/**
' * quickSort
' * 配列をクイックソートする
' * 大小比較できる型ならとりあえずソートできるはず
' * @param  Variant       aryVal sort対象配列
' * @param  Optional Long left   sort範囲左
' * @param  Optional Long right  sort範囲右
' * @return sort後配列
' */
Sub quickSort(ByRef aryVal As Variant, Optional ByVal left As Long = -1, _
                                       Optional ByVal right As Long = -1)
    Dim l As Long
    Dim r As Long
    Dim pivot As Variant
    Dim tmp As Variant

    If left = -1 Or right = -1 Then
        left = LBound(aryVal)
        right = UBound(aryVal)
    End If
    
    l = left
    r = right
    'ソート範囲の中央の値を取得
    pivot = aryVal(Int((left + right) / 2))
    
    Do
        '配列の先頭から、中央の値より大きいものを探す
        Do While aryVal(l) < pivot
            l = l + 1
        Loop
        '配列の末尾から、中央の値より小さいものを探す
        Do While aryVal(r) > pivot
            r = r - 1
        Loop
        
        'ソートの必要がなければループ終了
        If l >= r Then Exit Do
        
        '前半部の大きい値と後半部の小さい値を入れ替える
        tmp = aryVal(l)
        aryVal(l) = aryVal(r)
        aryVal(r) = tmp
        
        l = l + 1
        r = r - 1
    Loop
    
    'ソートが終わるまで再帰的に自分を呼び出し
    If (left < l - 1) Then
        Call quickSort(aryVal, left, l - 1)
    End If
    
    If (right > r + 1) Then
        Call quickSort(aryVal, r + 1, right)
    End If
End Sub

'/**
' * bubbleSort
' * 配列をバブルソートする
' * 大小比較できる型ならとりあえずソートできるはず
' * @param  aryVal sort対象配列
' * @return sort後配列
' */
Sub bubbleSort(ByRef aryVal As Variant)
    Dim i As Long
    Dim j As Long
    Dim tmp As Variant
    
    For i = 0 To UBound(aryVal)
        For j = UBound(aryVal) To i Step -1
            If aryVal(i) > aryVal(j) Then
                tmp = aryVal(i)
                aryVal(i) = aryVal(j)
                aryVal(j) = tmp
            End If
        Next j
    Next i
End Sub
'テスト用
Sub test()

    Dim aryQuick() As Variant: ReDim aryQuick(0)
    Dim aryBubble() As Variant: ReDim aryBubble(0)
    Dim i As Long
    '乱数で配列生成
    For i = 0 To 10000
        ReDim Preserve aryQuick(UBound(aryQuick) + 1)
        aryQuick(UBound(aryQuick)) = Int(Rnd * 10000)
        
        ReDim Preserve aryBubble(UBound(aryBubble) + 1)
        aryBubble(UBound(aryBubble)) = Int(Rnd * 10000)
    Next i
    
    'クイックソート開始
    Debug.Print Now()
    Call quickSort(aryQuick)
    'クイックソート終了
    'バブルソート開始
    Debug.Print Now()
    Call bubbleSort(aryBubble)
    'バブルソート終了
    Debug.Print Now()
End Sub

【VBA】Dir関数で指定パスのサブフォルダを全て取得する

'/**
' * getTargetFolders
' * 与えられたパス配下のフォルダをサブフォルダまで配列で取得する
' * @param  strDirectoryPath パス
' * @return フォルダ名のString配列
' */
Function getTargetFolders(ByVal strDirectoryPath As String) As String()
    
    Dim buf As String
    Dim i As Long: i = 0
    Dim folders() As String: ReDim folders(0)
    Dim nowPath As String
    
    folders(0) = strDirectoryPath
    
    '親フォルダループ
    Do
        nowPath = folders(i) & "\"
        buf = Dir(nowPath, vbDirectory)
        '子フォルダループ
        Do While buf <> ""
            If GetAttr(nowPath & buf) = vbDirectory _
               And buf <> "." And buf <> ".." Then
               
                ' ファイル名,ページ数の形で配列末尾に格納
                ReDim Preserve folders(UBound(folders) + 1)
                folders(UBound(folders)) = nowPath & buf
                    
            End If
            buf = Dir()
        Loop
        
        'フォルダ走査完了
        If i = UBound(folders) Then
            Exit Do
        Else
            i = i + 1
        End If
        
    Loop
    
    getTargetFolders = folders

End Function

参考: Dir関数で全サブフォルダの全ファイルを取得|ExcelマクロVBAサンプル集

【JavaScript】指定時間後や定期的に処理を実行する。

  • window.setInterval(function, delay)
    setIntervalは、functionに与えられた関数・処理をdelay(ms)ごとに繰り返す処理。

  • window.setTimeout(function, delay)
    setTimeoutは、functionに与えられた関数・処理をdelay(ms)後に実行する処理。

setIntervalで定義された処理を止める場合は、setIntervalの戻り値に対してclearIntervalを、
setTimeoutで定義された処理を止める場合は、setTimeoutの戻り値に対してclearTimeoutを行う。

<!DOCTYPE html>
<html lang="en">
    <head>
       <meta charset="UTF-8">
       <title>Title</title>
       <script>
       (function(){
           // windowのロード時にidがdatetimeのエレメントに時刻を挿入
           window.addEventListener("load",function(){
               document.getElementById("datetime").innerText = new Date().toString();
           },false);
           
           // 1000ms毎にidがdatetimeのエレメントの時刻を書き換え
           var interVal = window.setInterval(function(){
                               document.getElementById("datetime").innerText = new Date().toString();
                           }, 1000);
           // 10000ms後に繰り返し処理を終了する
           window.setTimeout(function(){
                               clearInterval(interVal);
                           }, 10000);
       })();
       </script>
   </head>
    <body>
        <p id="datetime"></p>
    </body>
</html>

【JavaScript】Objectタグのdata要素を変更する

HTMLElement.setAttribute("data",変更後data要素)だとIEでうまくいかなかったので、
IEも対応する場合はObject要素自体のDOMをreplaceChildで置き換えてやる必要がある。

/**
* changeObjectData
* objectタグの表示内容を更新する
*
* @param {object} element - 変更対象領域のエレメント
* @param {string} data - 変更後のdata要素
* @return {boolean} true
*/
function changeObjectData(element,data){
   //現在のObjectタグの内容を複製
   var cln = element.cloneNode(true);
   //複製したもののdata要素を変更する
   cln.setAttribute("data",data);
   //自分自身をdata要素変更後のエレメントに置き換える
   element.parentNode.replaceChild(cln, element);
   return true;
}

// ex.利用例
changeObjectData(document.getElementById("hoge"),"pdf/fuga.pdf");

【VBA/Excel】Excelの印刷総ページ数を取得してCSVで出力する

Option Explicit
'/**
' * getExcelProp
' * 与えられたパスに存在する、与えられた拡張子のExcelについて
' * [ファイル名],[ページ数]のカンマ区切りの形式でString配列を作成する
' * @param  filePath ファイルの存在するパス 末尾に\が必要
' * @param  fileType 拡張子
' * @return [ファイル名],[ページ数]のカンマ区切りString配列
' */
Function getExcelProp(ByVal filePath As String, ByVal fileType As String) As String()
    Dim wkBook As Workbook: Set wkBook = Nothing    '開くワークブックオブジェクト
    Dim buf As String                               'ファイル名用バッファ
    Dim page As Long                                'ファイル毎の総ページ数
    Dim i As Long                                   'Forのカウンタ
    Dim retVal() As String: ReDim retVal(0)         '戻り値用配列

On Error GoTo Proc_Exit
    ' 処理速度向上の為非表示
    Application.Visible = False
    ' ダイアログ非表示
    Application.DisplayAlerts = False

    buf = Dir(filePath & "*." & fileType)
    Do While buf <> ""
        'ページ数初期化
        page = 0
        
        'ページ数集計
        Set wkBook = Workbooks.Open(filePath & buf)
        For i = 1 To wkBook.Sheets.Count
            '2010以前のバグ対応のため改ページプレビューに切り替える
            wkBook.Sheets(i).Select
            ActiveWindow.View = xlPageBreakPreview
            
            'どっちを書いてもカウントできる
            page = page + wkBook.Sheets(i).PageSetup.Pages.Count
            'page = page + Application.ExecuteExcel4Macro("get.document(50)")
        Next i
        
        '動的に配列増やす(コスト的には微妙…)
        ReDim Preserve retVal(UBound(retVal) + 1)
        'ファイル名,ページ数の形で配列に格納
        retVal(UBound(retVal) - 1) = buf & "," & page
        
        wkBook.Close
        Set wkBook = Nothing
        buf = Dir()
    Loop
    
Proc_Exit:
    ' エラー時にクローズできてないワークブックを閉じる
    If Not wkBook Is Nothing Then
        wkBook.Close
        Set wkBook = Nothing
    End If
    
    'ダイアログ・アプリケーションを表示するように戻す
    Application.DisplayAlerts = True
    Application.Visible = True
    getExcelProp = retVal
End Function

'/**
' * OutputCsv
' * 文字列配列からCSVを作成する
' * @param  varData 文字列配列
' * @return なし
' */
Public Sub OutputCsv(ByVal varData As Variant)
    
    Dim lngFileNum As Long
    Dim strFileNm As String
    Dim strOutPutFile As String
    Dim item As Variant
    
    'ファイル名を現在の日付にする
    strFileNm = Format(Now(), "yyyymmdd") & ".csv"
        
    ' 出力先ディレクトリ設定
    ' とりあえずこのExcelファイルと同じフォルダに出力
    strOutPutFile = ActiveWorkbook.Path & "\" & strFileNm
    
    'ファイル作成(または追記モードでオープン)
    lngFileNum = FreeFile()
    Open strOutPutFile For Append As #lngFileNum
    
    ' 配列の中身を一行ずつ追記
    For Each item In varData
        If item <> "" Then
            Print #lngFileNum, item
        End If
    Next item
    
    Close #lngFileNum

End Sub

Sub test()
    
    'OutputCsv (getExcelProp(ファイルパス, "xls"))
End Sub

【JavaScript】HTMLのテーブルをソートするsorTable.jsを作ってみました

github.com

すでにあるのかもしれないけど、jQuery無しで動作するHTMLテーブルのソートのやつを作りました。
Git初心者なのでコミットログが汚い...
とりあえず公開してみた状態なので、そのうち直したりしてみようかなと思ってます。

下記はデモページの埋め込み