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