** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - Utilidades: Código Qr
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoUtilidades: Código Qr

 Responder Responder
Autor
Mensaje
emiliove Ver desplegable
Moderador
Moderador


Unido: 16/Junio/2009
Localización: Mexico
Estado: Sin conexión
Puntos: 4927
Enlace directo a este mensaje Tema: Utilidades: Código Qr
    Enviado: 28/Enero/2014 a las 16:19
Aunque ya se a hablado del tema y existen en el mercado compañias que venden generadores de código de barras y código Qr, aunque son de paga, su precio no es muy caro, pero si queremos generar esporadicamente código Qr, lo podemos hacer directo desde internet, con alguna aplicación gratuita, en este caso vamos a usar la api de Google.
Como todo cambia no sabemos en que momento Google vaya a cambiar algun parámetro o quitar el servicio de generación de Qr asi que ignoramos cuanto tiempo servirá. Y desde luego que necesitas estar conectado a internet para que funcione.
 
Para generar el códígo Qr esta tomado de una esplicación en PHP:
 
 
Yo solo lo pase a VBA y use una función que el Buho tenia en su página para bajar archivos, en fin que es pura copia.
 
Hay que crear un formulario independiente con cuatro cuadros de texto con nombres: txtCampo1, txtCampo2, txtCampo3, txtCampo4, un control imagen: imagen17 en visible= false y un boton: Comando10
 
Y colocamos este código en el módulo del Formulario:
 
Option Compare Database
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub DownloadQRcode(url As String, pngName As String)
 Dim host As Long
 Dim elerror As String
 Dim Borde As Long
 Dim size As Long
 
 size = 360          ' Tamaño de la imagen en pixeles S, M, L: 160, 260, 360
 host = Int((10 - 1 + 1) * Rnd) 'Para usar un servidor de google diferente tiene 10
 elerror = "H"   'Puede ser L (7%), M (15%), Q (25%), H (30%) es la pérdida de datos y agregamos el parametro opcional chld
 Borde = 2      'Es la distancia a un lado del codigo qr va desde 1 al 4 siendo el cuatro el default y mas grande
    
   DownloadFile "http://" & host & ".chart.apis.google.com/chart?chs=" & size & "x" & size & "&cht=qr&chld=" & elerror & "|" & Borde & "&chl=" & url, pngName
End Sub
 
Sub Test_DownloadQRcode()
Dim elnombre As String
elnombre = Left(txtCampo1, 4)       'Asignamos el nombre del archivo las 4 primeras letras del primer campo
 
    DownloadQRcode txtCampo1 & "=" & txtCampo2 & "=" & txtCampo3 & "=" & txtCampo4 , CurrentProject.Path & "\" & elnombre & "qr.png"

    Shell "cmd /c """ & Application.CurrentProject.Path & "\" & elnombre & "qr.png"""
End Sub
Function DownloadFile(url As String, LocalFileName As String) As Boolean
    If URLDownloadToFile(0, url, LocalFileName, 0, 0) = 0 Then
        DownloadFile = True
    End If
End Function
Private Sub Comando10_Click()
Dim elnombre As String
elnombre = Left(txtCampo1, 4)
Call Test_DownloadQRcode
DoEvents
Me.Imagen17.Picture = CurrentProject.Path & "\" & elnombre & "qr.png"
Me.Imagen17.Visible = True
End Sub
Con algunos arreglos más lo pueden bajar en:
 

Se llama GeneraQr, y esta para las dos versiones access2003 y 2007.
 
Espero que les sirva a alguien, saludos.


Editado por emiliove - 28/Enero/2014 a las 19:46
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable