Comment puis-je générer des GUIDs dans Excel?

j'ai utilisé la fonction suivante dans v. 2013 excel vba pour créer un guide et fonctionne bien..

Public Function GetGUID() As String 
    GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36) 
End Function 

je sais que cette question Est répondue, mais je pense que le code en question devrait ressembler à quelque chose comme ce qui est sur cette page: http://snipplr.com/view/37940 /

N'ont pas testé, mais ce code semble puiser dans L'API Windows pour obtenir ses directives - je voudrais essayer de mettre cela dans un module public et en tapant =GetGUId() dans une cellule Excel pour voir ce que je obtiendrais. S'il fonctionne en VB6, vous avez de bonnes chances qu'il fonctionne aussi en VBA:

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Public Function GetGUID() As String
'(c) 2000 Gus Molina

    Dim udtGUID As GUID

    If (CoCreateGuid(udtGUID) = 0) Then

        GetGUID = _
            String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _
            String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _
            String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _
            IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
            IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _
            IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
            IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
            IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
            IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
            IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
            IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))
    End If

End Function

Merci Gus Molina!

si ce code fonctionne (ce dont je ne doute pas), je pense que vous obtiendriez un nouvel ensemble de GUID à chaque fois que la fonction est évaluée, ce qui signifie Chaque fois que la feuille est calculée - quand vous sauvegardez le classeur, par exemple. Assurez-vous de copier les valeurs-pastespecial si vous avez besoin des GUID pour une utilisation ultérieure... ce qui est assez probable.

idem pour Allemand Excel version:

=VERKETTEN(DEZINHEX(ZUFALLSBEREICH(0;4294967295);8);"-";DEZINHEX(ZUFALLSBEREICH(0;65535);4);"-";DEZINHEX(ZUFALLSBEREICH(16384;20479);4);"-";DEZINHEX(ZUFALLSBEREICH(32768;49151);4);"-";DEZINHEX(ZUFALLSBEREICH(0;65535);4);DEZINHEX(ZUFALLSBEREICH(0;4294967295);8))

j'ai trouvé une jolie solution ici:

http://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=751237&msg=8634441

Option Explicit

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
Private Declare Function CoCreateGuid Lib "ole32" (pguid As GUID) As Long
Private Declare Function StringFromGUID2 Lib "ole32" ( _
  rguid As GUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long

Public Function CreateGUID() As String
  Dim NewGUID As GUID
  CoCreateGuid NewGUID
  CreateGUID = Space$(38)
  StringFromGUID2 NewGUID, StrPtr(CreateGUID), 39
End Function

une approche VBA basée sur la génération de nombres aléatoires à l'aide de la fonction Rnd() , et non sur les appels API externes ou Scriptlet.TypeLib :

Public Function CreateGUID() As String
    Do While Len(CreateGUID) < 32
        If Len(CreateGUID) = 16 Then
            '17th character holds version information
            CreateGUID = CreateGUID & Hex$(8 + CInt(Rnd * 3))
        End If
        CreateGUID = CreateGUID & Hex$(CInt(Rnd * 15))
    Loop
    CreateGUID = "{" & Mid(CreateGUID, 1, 8) & "-" & Mid(CreateGUID, 9, 4) & "-" & Mid(CreateGUID, 13, 4) & "-" & Mid(CreateGUID, 17, 4) & "-" & Mid(CreateGUID, 21, 12) & "}"
End Function

il s'agit essentiellement d'une implémentation VBA de la réponse de NekojiruSou (elle génère également une interface graphique v4), et comporte les mêmes limitations, mais fonctionnera en VBA et pourrait être plus facile à implémenter.

Notez que vous pouvez omettre la dernière ligne à ne pas retourner les tirets et les accolades dans le résultat.

depuis la suppression de windows update " Scriptlet.TypeLib", essayez ce qui suit:

Declare Function CoCreateGuid Lib "ole32" (ByRef GUID As Byte) As Long
Public Function GenerateGUID() As String
    Dim ID(0 To 15) As Byte
    Dim N As Long
    Dim GUID As String
    Dim Res As Long
    Res = CoCreateGuid(ID(0))

    For N = 0 To 15
        GUID = GUID & IIf(ID(N) < 16, "0", "") & Hex$(ID(N))
        If Len(GUID) = 8 Or Len(GUID) = 13 Or Len(GUID) = 18 Or Len(GUID) = 23 Then
            GUID = GUID & "-"
        End If
    Next N
    GenerateGUID = GUID
End Function

alternativement,

si vous vous connectez à SQL Server 2008 ou plus, essayez D'utiliser la fonction SQL NEWID() à la place.

si vous insérez des enregistrements dans une base de données, vous pouvez utiliser cette façon pour faire un GUID.

c'est probablement la façon la plus simple et la plus facile de mettre en œuvre que vous n'avez pas besoin d'une fonction complexe VBA que vous utilisez la fonction SQL construit.

la déclaration utilise NewID() ,

la syntaxe est la suivante,

INSERT INTO table_name (ID,Column1,Column2,Column3)
VALUES (NewID(),value1,value2,value3) 

Dans VBA la syntaxe est comme suit,

strSql = "INSERT INTO table_name " _
       & "(ID,Column1,Column2,Column3) " _
       & "VALUES (NewID(),value1,value2,value3)"

et si vous avez besoin de concaténer des valeurs, il suffit de le traiter comme une chaîne et concaténer comme vous le feriez normalement pour une instruction SQL,

strSql = "INSERT INTO table_name " _
       & "(ID,Column1,Column2,Column3) " _
       & "VALUES (" & "NewID()" & "," & "value1" & "," & "value2" & "," & "value3" & ")"

j'ai récemment rencontré des problèmes en utilisant CreateObject ("Scriptlet.TypeLib") dans un code vba.

ainsi basé sur les fonctions excel de NekojiruSou a écrit ce qui suit qui devrait fonctionner sans aucune fonction excel spécifique. Cela peut être utilisé pour développer une fonction définie par l'utilisateur dans excel.

Public Function Get_NewGUID() As String
    'Returns GUID as string 36 characters long

    Randomize

    Dim r1a As Long
    Dim r1b As Long
    Dim r2 As Long
    Dim r3 As Long
    Dim r4 As Long
    Dim r5a As Long
    Dim r5b As Long
    Dim r5c As Long

    'randomValue = CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
    r1a = RandomBetween(0, 65535)
    r1b = RandomBetween(0, 65535)
    r2 = RandomBetween(0, 65535)
    r3 = RandomBetween(16384, 20479)
    r4 = RandomBetween(32768, 49151)
    r5a = RandomBetween(0, 65535)
    r5b = RandomBetween(0, 65535)
    r5c = RandomBetween(0, 65535)

    Get_NewGUID = (PadHex(r1a, 4) & PadHex(r1b, 4) & "-" & PadHex(r2, 4) & "-" & PadHex(r3, 4) & "-" & PadHex(r4, 4) & "-" & PadHex(r5a, 4) & PadHex(r5b, 4) & PadHex(r5c, 4))

End Function

Public Function Floor(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
    'From: http://www.tek-tips.com/faqs.cfm?fid=5031
    ' X is the value you want to round
    ' Factor is the multiple to which you want to round
        Floor = Int(X / Factor) * Factor
End Function

Public Function RandomBetween(ByVal StartRange As Long, ByVal EndRange As Long) As Long
    'Based on https://msdn.microsoft.com/en-us/library/f7s023d2(v=vs.90).aspx
    '         randomValue = CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
        RandomBetween = CLng(Floor((EndRange - StartRange + 1) * Rnd())) + StartRange
End Function

Public Function PadLeft(text As Variant, totalLength As Integer, padCharacter As String) As String
    'Based on /q/any-method-equivalent-to-padleft-padright-42762/"" Then
        padCharacter = " "
    ElseIf Len(padCharacter) > 1 Then
        padCharacter = Left(padCharacter, 1)
    End If

    If inputLength < totalLength Then
        PadLeft = String(totalLength - inputLength, padCharacter) & s
    Else
        PadLeft = s
    End If

End Function

Public Function PadHex(number As Long, length As Integer) As String
    PadHex = PadLeft(Hex(number), 4, "0")
End Function

Function funGetGuid() As String

    Const URL As String = "http://www.guidgen.com/"
    Const strMask As String = "value="

    Dim l As Long
    Dim txt As String

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        txt = .responseText
    End With

    Do
        l = InStr(l + 1, txt, strMask)
        If l = 0 Then Exit Do
        funGetGuid = Mid$(txt, l + Len(strMask) + 1, 36)
    Loop

End Function