自定義密碼生成器 Excel VBA 宏

Question

我需要使用 VBA Excel 創建密碼生成器，自定義密碼復雜度，我發現這段代碼工作正常，問題是當我關閉 XLS 文件並再次打開時，宏生成相同的密碼，所以不是完全隨機的發電機：

Sub Password_Click()
'
' Bruno Campanini 14-02-2007 Excel 2007
' Statistica.xls Sheet: Sheet10 Button: Password
'
' Compone NumPSW Password formate da:
' NumAlpha caratteri alfabetici
' NumNonAlpha caratteri non-alfabetici
' NumNum caratteri numerici
' definiti random.
'
Dim AlphaChar(1 To 26) As String, NumChar(1 To 10) As String
Dim NonAlphaChar(1 To 30) As String
Dim i As Integer, j As Integer, NumPSW As Integer
Dim NumAlpha As Integer, NumNum As Integer, NumNonAlpha As Integer
Dim PSW As String, PSWRandom As String, PSWColl As Collection
Dim R As Integer, RR As Integer, RRR As Integer, NumMaiuscole As Integer
Dim FinalRandom As Boolean, TargetRange As Range

' 26 caratteri Alpha (a - z)
For i = 97 To 122
AlphaChar(i - 96) = Chr(i)
Next

' 10 caratteri numerici (0 - 9)
For i = 1 To 10
NumChar(i) = i - 1
Next

' 30 caratteri non-Alpha
NonAlphaChar(1) = "\": NonAlphaChar(2) = "|": NonAlphaChar(3) = "!"
NonAlphaChar(4) = Chr(34): NonAlphaChar(5) = "%": NonAlphaChar(6) = "&"
NonAlphaChar(7) = "/": NonAlphaChar(8) = "(": NonAlphaChar(9) = ")"
NonAlphaChar(10) = "=": NonAlphaChar(11) = "?": NonAlphaChar(12) = "'"
NonAlphaChar(13) = "^": NonAlphaChar(14) = "_": NonAlphaChar(15) = "-"
NonAlphaChar(16) = ".": NonAlphaChar(17) = ":": NonAlphaChar(18) = ","
NonAlphaChar(19) = ";": NonAlphaChar(20) = "@": NonAlphaChar(21) = "#"
NonAlphaChar(22) = "*": NonAlphaChar(23) = "+": NonAlphaChar(24) = "["
NonAlphaChar(25) = "]": NonAlphaChar(26) = "[": NonAlphaChar(27) = "]"
NonAlphaChar(28) = "$": NonAlphaChar(29) = "<": NonAlphaChar(30) = ">"

' Definizioni ------------------------------------------
NumAlpha = 6 ' Numero caratteri alfabetici
NumNonAlpha = 1 ' Numero caratteri non alfabetici
NumNum = 4 ' Numero caratteri numerici
NumMaiuscole = 3 ' Numero maiuscole
FinalRandom = True ' Rimescolamento random finale
'
NumPSW = 10 ' Numero password da generare
Set TargetRange = [Sheet1!A1] ' Destinazione
' ------------------------------------------------------

If NumMaiuscole > NumAlpha Then
MsgBox "Non possono esservi " & NumMaiuscole & _
" maiuscole su " & NumAlpha & " caratteri!"
Exit Sub
End If

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For j = 1 To NumPSW
PSW = ""

' Definisce il gruppo AlphaChar
R = NumAlpha
RR = UBound(AlphaChar)
GoSub LoadCollection
For i = 1 To NumAlpha
PSW = PSW & AlphaChar(PSWColl(i))
Next

' Definisce le Maiuscole
R = NumMaiuscole
RR = R
GoSub LoadCollection
For i = 1 To NumMaiuscole
Mid(PSW, PSWColl(i), 1) = UCase(Mid(PSW, PSWColl(i), 1))
Next

' Definisce il gruppo NonAlphaChar
R = NumNonAlpha
RR = UBound(NonAlphaChar)
GoSub LoadCollection
For i = 1 To NumNonAlpha
PSW = PSW & NonAlphaChar(PSWColl(i))
Next

' Definisce il gruppo NumChar
R = NumNum
RR = UBound(NumChar)
GoSub LoadCollection
For i = 1 To NumNum
PSW = PSW & NumChar(PSWColl(i))
Next

If FinalRandom Then
' Rimescola Random i tre gruppi
R = NumAlpha + NumNonAlpha + NumNum
RR = R
GoSub LoadCollection
PSWRandom = ""
For i = 1 To NumAlpha + NumNonAlpha + NumNum
PSWRandom = PSWRandom & Mid(PSW, PSWColl(i), 1)
Next
PSW = PSWRandom
End If

TargetRange(j) = "'" & PSW
Next

Exit_Sub:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

' Carica PSWColl con valori unici
LoadCollection:
Set PSWColl = New Collection
Do Until PSWColl.Count = R
RRR = Int((RR) * Rnd + 1)
On Error Resume Next
PSWColl.Add RRR, CStr(RRR)
On Error GoTo 0
Loop
Return

End Sub

謝謝

每次打開文件時是否可以修改代碼以生成隨機密碼？

謝謝

Answer 1

計算機無法生成真正的隨機數。 它們生成偽隨機數：當您從 Excel 請求一個隨機數時，它會以基於“種子”值的看似隨機的序列中的第一個數字作為響應。

后續請求僅調用該序列中的下一個數字。 重置 Excel 后，它會再次回到第一個數字，並且表現與之前完全相同。 這就是你正在經歷的。

但是，沿着數字序列移動是可能的 - 使用Randomize(seed_value)命令稱為“更改種子”：

Randomize(50) 'sets the seed to 50

生成看起來更隨機的種子的一種方法是使用不太可能與上次調用時相同的值。 獨立於代碼本身的東西。 最簡單的是使用計時器——基本上是自午夜以來的毫秒數——作為種子數。 連續兩次出現這種情況，也太巧合了吧！

微軟給了我們一個方便的方法來使用它：如果沒有參數傳遞給 Randomize，它使用 Timer 值作為種子值：

Randomize 'sets the seed to the timer