【VBA】乱数パスワードを自動生成するモジュール

Sub Sample()
Dim PW As String
PW = SetPassword(4, 12)
End Sub

Public Function SetPassword(Optional PasswordType As Long = 2, Optional PasswordLength As Long = 8) As String
'PasswordType   ---1:数値、2:英小文字数字、3:英大文字英小文字数字、4:記号英小文字数字
'PasswordLength ---パスワードの文字数
Dim strPtt As String
Dim strExt As String
Dim i As Long
Dim RndMode As Long

'---パスワードタイプが規定範囲じゃなかったら強制的に数値だけにする
If PasswordType < 1 Or PasswordType > 4 Then PasswordType = 1
'---パスワードの桁数は最低でも4桁にする
If PasswordLength < 4 Then PasswordLength = 4
'---全種が必ず一度は出現するようにパターン設定する
strPtt = String(PasswordLength, "0")
For i = 1 To PasswordType
    Do
        strExt = Application.WorksheetFunction.RandBetween(1, PasswordLength)
        If Mid(strPtt, strExt, 1) = "0" Then
            strPtt = Left(strPtt, strExt - 1) & CStr(i) & Right(strPtt, PasswordLength - strExt)
            Exit Do
        End If
    Loop
Next
'---未指定の桁を乱数で埋める
For i = 1 To PasswordLength
    If Mid(strPtt, i, 1) = "0" Then
        strPtt = Left(strPtt, i - 1) & CStr(Application.WorksheetFunction.RandBetween(1, PasswordType)) & Right(strPtt, PasswordLength - i)
    End If
Next
'---各桁のパターンに合わせた文字コードの乱数を生成してChr関数で文字に変換する
For i = 1 To PasswordLength
    Select Case CLng(Mid(strPtt, i, 1))
        Case 1 '---数値
            SetPassword = SetPassword & Chr(Application.WorksheetFunction.RandBetween(48, 57))
        Case 2 '---小文字英字
            SetPassword = SetPassword & Chr(Application.WorksheetFunction.RandBetween(97, 122))
        Case 3 '---大文字英字
            SetPassword = SetPassword & Chr(Application.WorksheetFunction.RandBetween(65, 90))
        Case 4 '---記号　※対象の記号→!"#$%&'()-^\@[;:],./=~|`{+*}<>?_
            SetPassword = SetPassword & Chr(RandTarget(33, 34, 35, 36, 37, 38, 40, 41, 42, 43, 44, 45, 46, 47, 58, 59, 60, 61, 62, 63, 64, 91, 92, 93, 94, 95, 96, 123, 124, 125, 126))
    End Select
Next
End Function
Public Function RandTarget(ParamArray arr() As Variant) As Long
Dim lngRndMin As Long, lngRndMax As Long, lngRnd As Long
Dim objDic As Scripting.Dictionary
Dim v As Variant
Set objDic = CreateObject("Scripting.Dictionary")
For Each v In arr
    If IsNumeric(v) And objDic.Exists(CLng(v)) = False Then
        objDic.Add CLng(v), CLng(v)
    End If
Next
lngRndMin = Application.WorksheetFunction.Min(objDic.Keys)
lngRndMax = Application.WorksheetFunction.Max(objDic.Keys)
Do
    lngRnd = Application.WorksheetFunction.RandBetween(lngRndMin, lngRndMax)
    If objDic.Exists(lngRnd) Then
        RandTarget = lngRnd
        Exit Do
    End If
Loop
Set objDic = Nothing
End Function