Generar codigo QR (Mejorar macro)

[CarlosKurt]

Hola a tod@s, nuevamente solicitando su tiempo y aporte para ese nuevo tema.

El siguiente codigo lo encontre en la Web.

#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
    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
#End If

Sub CrearQRMasivo()
    Dim n&, I&
    LimpiarImagenes
    With wGenerador
        n = .Range("H" & Rows.Count).End(xlUp).Row
        For I = 2 To n
            CrearQRIndividual .Range("H" & 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=300x300&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("I" & Valor.Row).Top
            lado = .Range("I" & Valor.Row).Width
            izqui = .Range("I" & Valor.Row).Left
            With QR
                .Top = nTop
                .Width = lado
                .Left = izqui
            End With
            .Range("I" & Valor.Row).RowHeight = lado
        End With
    '-----------------
        
End Sub

Sub LimpiarTodo()
    LimpiarImagenes
    wGenerador.Range("H2", "H" & Rows.Count) = Empty
End Sub

Sub LimpiarImagenes()
    Dim imagen As Picture
    For Each imagen In ActiveSheet.Pictures
        imagen.Delete
    Next
    wGenerador.Range("H2", "H" & Rows.Count).RowHeight = wGenerador.Range("H2").RowHeight
End Sub

Este código genera Imágenes QR; sin embargo cuando se copia la hoja completa para generar nuevas imagenes QR de otros productos; solo genera los mismo codigos de la hoja principal; se necesita que se genere imagenes QR para la nueva hoja .

Espero haberme hecho entender

 

Saludos

pruebaQr.xlsm

[Abraham Valencia]

Hola

Eso ocurre porque estás usando las mismas macros y en ellas hacen referencia a un solo módulo de una sola hoja. Cambia todo lo que dice "wGenerador" por "ActiveSheet". Saludos

[CarlosKurt]

Hace 6 horas, avalencia dijo:

Hola

Eso ocurre porque estás usando las mismas macros y en ellas hacen referencia a un solo módulo de una sola hoja. Cambia todo lo que dice "wGenerador" por "ActiveSheet". Saludos

Hola @avalencia, muchas gracias por su aporte. No sabia que "w" también representaría una "hoja".

Doy por terminado el tema.

Saludos