Cambiar nombre y tamaño imagen qr macro
Estoy realizando el proceso con esta función la cual me ayuda a generar el código qr y al tiempo guardar dicho código como imagen en una carpeta llamada QR_Imagen, esto funciona bien más deseo saber como puedo hacer que el nombre de la imagen cambie por el de una celda y este se actualice adjunto imágenes y código, el me toma el nombre de la celda b2 pero para todos
--codigo
Function QRCODE(codeText As String)
Dim objXML, Url As String, imgFile As String
Dim xStrImgName As String
Set objXML = CreateObject("Microsoft.XMLHttp")
Url = "https://chart.googleapis.com/chart?chs=250x250&cht=qr&chl=" & codeText
objXML.Open "Get", Url, False
objXML.Send
' quiero que ese range ("b2") sea automático y tome el valor que tenga en la celda
imgFile = CreateObject("wscript.shell").specialfolders("desktop") & "\QR_Imagen\" & _
Format(Now, "yyyymmdd") & Range("b2") & ".png"
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write objXML.ResponseBody
.SaveToFile imgFile, 2
.Close
End With
QRCODE = imgFile
End Function
1 respuesta
Visita:
Cursos de Excel y Macros
--------------------------------------------
Bienvenido a todoexpertos.
--------------------------------------------
¿Cómo estás haciendo el llamado de la función QRCODE?
Veo que le pasas como parámetro un texto:
Function QRCODE(codeText As String)
Podrías pasar también la celda, algo como esto:
Sub Proceso()
Dim i As Long
Dim codeText As String
Dim celda As String
Dim nombre As String
'
For i = 2 To 5
celda = Range("B" & i).Value
nombre = QRCODE(codeText, celda)
Next
End Sub
'
Function QRCODE(codeText As String, celda As String)
Dim objXML, Url As String, imgFile As String
Dim xStrImgName As String
Set objXML = CreateObject("Microsoft.XMLHttp")
Url = "https://chart.googleapis.com/chart?chs=250x250&cht=qr&chl=" & codeText
objXML.Open "Get", Url, False
objXML.Send
imgFile = CreateObject("wscript.shell").specialfolders("desktop") & "\QR_Imagen\" & _
Format(Now, "yyyymmdd") & celda & ".png"
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write objXML.ResponseBody
.SaveToFile imgFile, 2
.Close
End With
QRCODE = imgFile
End FunctionCursos de Excel recomendados:
https://www.youtube.com/watch?v=w7MYL3wDgH4&t=3s
https://www.youtube.com/watch?v=dy9w9zbkCaw&t=644s
https://www.youtube.com/watch?v=7Xhs04vhrtg&t=188s
---
Cursos de Macros recomendados:
https://www.youtube.com/watch?v=PupmVvM16-8&t=1s
https://www.youtube.com/watch?v=f_x8pstpNqc&t=3s
https://www.youtube.com/watch?v=5k0szqErdXg&t=689s
---
Sal u dos Dante Amor
