J'ai un fichier Excel avec une commande sur chaque ligne et je souhaite que chaque commande ait un identifiant unique. Il y aura donc une colonne ID unique. Chaque fois que je remplis une ligne, je souhaite qu'Excel remplisse automatiquement la colonne ID unique pour moi. J'ai fait des recherches et j'ai été dirigé vers les GUID. J'ai trouvé le code suivant:
Function GenGuid() As String
Dim TypeLib As Object
Dim Guid As String
Set TypeLib = CreateObject("Scriptlet.TypeLib")
Guid = TypeLib.Guid
' format is {24DD18D4-C902-497F-A64B-28B2FA741661}
Guid = Replace(Guid, "{", "")
Guid = Replace(Guid, "}", "")
Guid = Replace(Guid, "-", "")
GenGuid = Guid
End Function
mais je ne sais pas comment je peux l'appliquer. Toute aide serait grandement appréciée. Merci d'avance.
J'ai utilisé la fonction suivante dans v.2013 Excel vba pour créer un GUID et fonctionne bien ..
Public Function GetGUID() As String
GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function
Je sais que cette question a reçu une réponse, mais je pense que le code en question devrait ressembler à ce qui est écrit sur cette page: http://snipplr.com/view/37940/
N'a pas été testé, mais ce code semble puiser dans l'API Windows pour obtenir son GUID. J'essaierais de l'insérer dans un module public et de saisir =GetGUId()
dans une cellule Excel pour voir ce que j'obtiendrais. Si cela fonctionne dans VB6, vous avez de bonnes chances que cela fonctionne également dans 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 obtiendrez un nouvel ensemble de GUID chaque fois que la fonction sera évaluée, ce qui signifie à chaque fois que la feuille est calculée, par exemple lorsque vous enregistrez le classeur. Assurez-vous de copier-coller des valeurs-spéciales si vous avez besoin du GUID pour une utilisation ultérieure ... ce qui est assez probable.
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
Même chose pour allemand version Excel:
=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))
Une approche VBA basée sur la génération de nombres aléatoires à l'aide de la fonction Rnd()
et non sur des appels d'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 un GUID v4) et comporte les mêmes limitations, mais fonctionnera sous VBA et pourrait être plus facile à implémenter.
Notez que vous pouvez omettre la dernière ligne pour ne pas renvoyer les tirets et les accolades dans le résultat.
La mise à jour de Windows ayant été supprimée de "Scriptlet.TypeLib", procédez comme 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 version ultérieure, 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 méthode pour créer un GUID.
C'est probablement le moyen le plus simple et le plus simple d'implémenter, car vous n'avez pas besoin d'une fonction VBA
complexe puisque vous utilisez la fonction SQL intégrée.
La déclaration utilise NewID()
,
La syntaxe est la suivante,
INSERT INTO table_name (ID,Column1,Column2,Column3)
VALUES (NewID(),value1,value2,value3)
Dans la syntaxe VBA
, il 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, traitez-les simplement comme une chaîne et concaténez-les 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 lors de l'utilisation de CreateObject ("Scriptlet.TypeLib") dans du code vba.
Donc, basé sur NekojiruSou, les fonctions Excel ont écrit ce qui suit qui devrait fonctionner sans aucune fonction Excel spécifique. Ceci 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 https://stackoverflow.com/questions/12060347/any-method-equivalent-to-padleft-padright
' with a little more checking of inputs
Dim s As String
Dim inputLength As Integer
s = CStr(text)
inputLength = Len(s)
If padCharacter = "" 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