Código:
Function eXl_CrearQR(texto As String, tamano As Integer) As Variant
Dim url As String
Dim celda As Range
Dim nombreImagen As String
Dim img As Shape
On Error GoTo ErrorHandler
' Validación del texto
If Trim(texto) = "" Then
eXl_CrearQR = CVErr(xlErrValue)
Exit Function
End If
' Obtener la celda donde se ejecuta la fórmula
Set celda = Application.Caller.Cells(1, 1)
' Crear nombre único para la imagen del QR
nombreImagen = "QR_" & celda.Address(False, False)
' Borrar imagen previa con ese nombre (si existe)
On Error Resume Next
celda.Worksheet.Shapes(nombreImagen).Delete
On Error GoTo 0
' Construir la URL del QR con QRServer
url = "https://api.qrserver.com/v1/create-qr-code/?size=" & tamano & "x" & tamano & "&data=" & WorksheetFunction.EncodeURL(texto)
' Insertar imagen del QR
With celda.Worksheet.Pictures.Insert(url)
.ShapeRange.LockAspectRatio = msoFalse
.Height = tamano
.Width = tamano
.Top = celda.Top
.Left = celda.Left
.Name = nombreImagen
End With
eXl_CrearQR = "QR generado"
Exit Function
ErrorHandler:
eXl_CrearQR = CVErr(xlErrValue)
End Function
👉 Como hacer que la UDF (User Defined Functions) esté disponible como una Función Nativa de Excel
⭐ 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.
