H o l a:
Te anexo el siguiente código para generar una clave en base al número de serie del disco duro de la PC.
Ejecuta la macro en la PC que quieras obtener su número de serie y generar su clave.
La macro te desplegará un mensaje con el número de serie de la PC y la clave generada:
La macro:
Sub GenerarClave()
'Por.Dante Amor
b = ""
hdserial = CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber
'hdserial = [A5]
hdserial = Replace(hdserial, "-", "")
If Len(hdserial) < 7 Then
Select Case Len(hdserial)
Case 1
hdserial = hdserial & "234567"
Case 2
hdserial = hdserial & "34567"
Case 3
hdserial = hdserial & "4567"
Case 4
hdserial = hdserial & "567"
Case 5
hdserial = hdserial & "67"
Case 6
hdserial = hdserial & "7"
End Select
End If
For i = 1 To 7
l = Mid(hdserial, i, 1)
Select Case i
Case 1
a = Asc(l)
a = Mid(a, 2, 1)
a = Mid(Asc(l), 2, 1) + 65
Case 2
a = Mid(Asc(l), 2, 1) + 97
Case 3
a = Mid(Asc(l), 2, 1) + 33
Case 4
a = Mid(Asc(l), 2, 1) + 48
l = Mid(hdserial, 2, 1)
b = Mid(Asc(l), 2, 1) + 107
Case 5
a = Mid(Asc(l), 2, 1) + 65
Case 6
a = Mid(Asc(l), 2, 1) + 97
Case 7
a = Mid(Asc(l), 2, 1) + 33
End Select
n = Chr(a)
clave = clave & n
If b <> "" Then
n = Chr(b)
clave = clave & n
b = ""
End If
Next
MsgBox "La clave para la serie: " & hdserial & vbCr & vbCr & _
"Es: " & clave, vbInformation, "GENERADOR DE CLAVES"
End Sub
Sigue las Instrucciones para ejecutar la macro
- Abre tu archivo de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / Módulo
- En el panel del lado derecho copia la macro
- Para ejecutarla presiona F5
‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s