Generar código pc y serial activador en vba excel

Quisiera que me ayuden con este tema, quiero que genere una serie único de código de la pc y a la vez este código generado sirva para crear o generar la contraseña de acceso único para cada pc. Este lo vi en algunos video y páginas pero no se como lo hacen, quiero para adjuntar a mis archivos de excel.

Adjunto una imagen que encontré en una página web.

Respuesta
2

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

  1. Abre tu archivo de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro
  5. 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

Muchas gracias Dante, justo lo que estaba buscando, pero solo una duda más como hago para que la clave generada por la serie, se quede fijo en una celda cuando activo por primera vez la clave, para que cada vez que ingrese ya no este copiando la clave y solo le de ingresar en un botón.

O talvez hay otra manera de hacer que se active el archivo excel por primera vez y las siguientes ya no se muestre dicho registro de clave, caso contrario salgue un form con mensaje molesto para la activación.

Saludos.

H o l a:

Lo que hace la macro es tomar el número de serie de la PC y en base a éste generar una clave. Eso es lo que pediste. Ahora si quieres que ese código se almacene en alguna parte y luego quieres que se verifique si existe o no existe, eso implica crear otra macro u otras instrucciones. Valora esta respuesta y crea una nueva pregunta; en la nueva pregunta me explicas con detalle qué es lo que deseas.

S a l u d o s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas