Codigo:
Procedimiento 1
Sub GenerarQRCode(rango As Range, tamaño As Integer)
Dim urlQR As String, celda As Range, textoCodigo As String
Dim img As Picture
Dim nombreQR As String
For Each celda In rango
textoCodigo = Trim(celda.Value)
' Validación: si la celda está vacía, se salta
If textoCodigo <> "" Then
' Construimos URL para QRServer
urlQR = "https://api.qrserver.com/v1/create-qr-code/?size=" & tamaño & "x" & tamaño & "&data=" & WorksheetFunction.EncodeURL(textoCodigo)
' Asignar nombre único a la imagen
nombreQR = "QR_" & celda.Address(False, False)
' Eliminar QR previo si existe
On Error Resume Next
celda.Worksheet.Pictures(nombreQR).Delete
On Error GoTo 0
' Insertar la nueva imagen
Set img = celda.Worksheet.Pictures.Insert(urlQR)
With img
.ShapeRange.LockAspectRatio = msoFalse
.Name = nombreQR
.Left = celda.Left + 2
.Top = celda.Top + 2
.Height = tamaño
.Width = tamaño
End With
End If
Next celda
End Sub
Procedimiento 2
Sub EjecutarQRCode()
Dim rango As Range
Set rango = Selection
Dim tamaño As Variant
tamaño = InputBox("Por favor, introduce el tamaño del código QR (ej. 150):", "Tamaño del código QR", 150)
' Validar entrada del usuario
If Not IsNumeric(tamaño) Or tamaño <= 0 Then
MsgBox "Tamaño inválido. Por favor ingresa un número mayor que cero.", vbExclamation
Exit Sub
End If
' Llamar a la rutina para generar códigos QR
GenerarQrCode rango, CInt(tamaño)
End Sub
⭐ Si te gustó, por favor regístrate en nuestra Lista de correo y Suscríbete a mi canal de YouTube para que estés siempre enterado de lo nuevo que publicamos.
