Option Explicit

'#########################################
'#+++++++Get Randome Value as String++++++++#
'#++++++++++++++++++++++++++++++++++#
'#Autor:	Daniel Frauenrath	(DanielFr.)						#
'#Datum: 	2012-07-28												#
'#Lic: 		Free to use, change, etc.							#
'#written for CAD.de													#
'#########################################


'globales Array der Zeichenfolge
Private arrRngNumbers() 'As Integer

Sub CATMain()

    'Deklarationen
    Dim i 'As Integer
    Const intLBound = 1 					'Untere Grenze fuer EINE Zahlenstelle (Std: 1)
    Const intUbound = 16 				'Untere Grenze fuer EINE Zahlenstelle (max. 16)
    Const lngDigitLen = 32				'Anzahl der Stellen der Zufallszahl (ca. 32) / Performace
    Dim strHexNumber 'As String		'Nummer die uebergeben wird als String
    Dim strHexTemp 'As String		'Temp-Variable fuer Formatierung
    Dim strHexTemp2 'As String		'Temp-Variable fuer Formatierung
    
    'Stellenanzahl zuweise
    ReDim arrRngNumbers(lngDigitLen)
    
    'Schleife zum erzeugen der Zufallszahlen
    For i = 1 To lngDigitLen
        arrRngNumbers(i) = FuncGetRndNumber(intLBound, intUbound)
    Next
    
    'Array zufaellig sortieren
    FuncRenArry
    
    'Zahl aus dem Array ermitteln
    'Ersten acht Zeichen
    For i = 1 To UBound(arrRngNumbers)
        strHexNumber = CStr(strHexNumber & Hex(arrRngNumbers(i)))
    Next
        
    'String formatieren
    strHexTemp = Left(strHexNumber, 8)
    strHexTemp2 = strHexTemp
    strHexTemp = Mid(strHexNumber, 9, 4)
    strHexTemp2 = strHexTemp2 + "-" + strHexTemp
    strHexTemp = Mid(strHexNumber, 13, 4)
    strHexTemp2 = strHexTemp2 + "-" + strHexTemp
    strHexTemp = Mid(strHexNumber, 17, 4)
    strHexTemp2 = strHexTemp2 + "-" + strHexTemp
    strHexTemp = Mid(strHexNumber, 21)
    strHexTemp2 = strHexTemp2 + "-" + strHexTemp
    
    'Ausgabe in String uebergeben
    'strHexNumber = strHexTemp2

   
    'Debuggung Ausgabe
    MsgBox "Zufallszahl [Hex] = " & strHexNumber + chr(10)+ _
            "Zufallszahl - geordnet [Hex] = " & strHexTemp2, vbInformation, "Zufallszahl ermittelt"

End Sub

'***Funktion zur Erzeugung einer Zufallszahl zwischen zwei Grenzen
Private Function FuncGetRndNumber(ByVal intLBound, ByVal intUbound) 'As Integer

    'Deklarationen
    Dim douZufallszahl 'As Double
    
'Fehlerbehandlung
On Error Resume Next
    
    Randomize                                               'Zufallsgenerator initialisieren
    douZufallszahl = Round(Rnd, 10)         'Zufallszahl mit vielen Nachkommastellen erzeugen                                          ' -

'Rueckgabe der Funktion
If Err.Number <> 0 Then
    FuncError Err.Number, Err.Description
    FuncGetRndNumber = 0
Else
    'Integer Zufallszahl zurueckgeben
    FuncGetRndNumber = Int(intLBound + (intUbound - intLBound + 1) * douZufallszahl)
End If

End Function

'Funktion zum zufaelligen sortieren eines Arrays
Private Function FuncRenArry() 'As Boolean

    'Deklarationen
    Dim arrTempArray() 'As Integer		'Temporaeres Array erzeugen
    Dim i 'As Long								'Allgemeiner Schleifenzaehler			
    Dim lngDisplace 'As Long				'Index des Array Eintrages
    Dim intUbound 'As Integer				'Obere Arraygrenze (nur VBS)
    
'Fehlerbehandlung
On Error Resume Next
    
    'Initialisierung des Zufallsgenerators
    Randomize
    
    'Obergrenze des originalen Array lesen
    intUbound = UBound(arrRngNumbers)
    
    'Dimension des temporaeren Array setzen
    ReDim arrTempArray(intUbound)
    
    'Array umsortieren
    For i = LBound(arrRngNumbers) To UBound(arrRngNumbers)
        lngDisplace = Int(LBound(arrRngNumbers) + (UBound(arrRngNumbers) - LBound(arrRngNumbers) + 1) * Rnd)
        arrTempArray(i) = arrTempArray(lngDisplace)
        arrTempArray(lngDisplace) = arrRngNumbers(i)
    Next
    
'Rueckgabe der Funktion
If Err.Number <> 0 Then
    FuncError Err.Number, Err.Description
End If

End Function

'Ausgaberoutine (Status, Zufallszahl, Fehlernummer- und Beschreibung werden unterstuetzt)
Private Function FuncError(ByVal lngErrNumber, strErrMessage)
                            
    'Fehlerausgabe
    MsgBox "Eine behandelte Laufzeitausahme ist aufgetreten:" + Chr(10) + _
            "Fehlernummer:" + Chr(34) + CStr(lngErrNumber) + Chr(10) + _
            "Beschreibung:" + Chr(34) + strErrMessage + Chr(10) + _
           "Ws wurde keine Zufallszahl erzeugt!", vbCritical, "Laufzeitfehler " & CStr(lngErrNumber)
    
End Function