En este video se muestra como generar códigos QR desde un Excel de forma rápida y poder administrarlos desde cualquier panel de control de acceso a través de nuestros nuevos lectores de códigos QR. Se anexa código para poder configurarlo en la macros de Excel.

NOTA: No se da soporte del código. En caso de algo en especial, ya es necesario consultarlo con algún desarrollador.

CODIGO:

#If VBA7 And Win64 Then

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _

Alias "URLDownloadToFileA" ( _

ByVal pCaller As LongPtr, _

ByVal szURL As String, _

ByVal szFileName As String, _

ByVal dwReserved As LongPtr, _

ByVal lpfnCB As LongPtr _

) As Long

#Else

#End If

Sub CrearQRMasivo()

Dim n&, i&

LimpiarImagenes

With wGenerador

n = .Range("A" & Rows.Count).End(xlUp).Row

For i = 4 To n

CrearQRIndividual .Range("A" & i)

Next

End With

End Sub

Sub CrearQRIndividual(Valor As Range)

Dim Link$, Ruta$, QR As Object

Dim lado&, izqui&, nTop&

'Descargo el código QR

If Valor.Value = Empty Then

Exit Sub

End If

Link = "http://chart.apis.google.com/chart?cht=qr&chs=500x500&chl=" & Valor.Value & "&chld=H|0"

Ruta = ThisWorkbook.Path & "\chart.png"

URLDownloadToFile 0, Link, Ruta, 0, 0

'-----------------

'Ingreso la imagen

Set QR = ActiveSheet.Pictures.Insert(Ruta)

Kill Ruta

With wGenerador

nTop = .Range("B" & Valor.Row).Top

lado = .Range("B" & Valor.Row).Width

izqui = .Range("B" & Valor.Row).Left

With QR

.Top = nTop

.Width = lado

.Left = izqui

End With

.Range("B" & Valor.Row).RowHeight = lado

End With

'-----------------

End Sub

Sub LimpiarImagenes()

Dim imagen As Picture

For Each imagen In ActiveSheet.Pictures

imagen.Delete

Next

wGenerador.Range("A4", "A" & Rows.Count).RowHeight = wGenerador.Range("A1").RowHeight

End Sub

¿Encontró su respuesta?