Marcelo David- Moderador
- Respeito às regras :
Sexo :
Localização :
Mensagens : 3948
Registrado : 21/04/2011
Marcelo David 11/4/2024, 15:02
Bom dia!
Esse código usa uma api que foi descontinuada pelo google.
Como sugestão tem essa: api.qrserver.com.
Vou posta o código já atualizado para essa api. Teste por favor.
- Código:
Dim twebqrc As String
Dim MinhaLinha, InfoMarchant, ID As String
Dim crc As Integer, t As Integer
MinhaLinha = "000201"
MinhaLinha = MinhaLinha & "26"
InfoMarchant = "0014br.gov.bcb.pix" & "01"
'MsgBox Len(CStr(Len(txtPix)))
If Len(CStr(Len(txtPix))) = 1 Then
InfoMarchant = InfoMarchant & "0" & Len(txtPix) & txtPix
Else
InfoMarchant = InfoMarchant & Len(txtPix) & txtPix
End If
If txtDescricao <> "" Then
InfoMarchant = InfoMarchant & "02"
If Len(CStr(Len(txtDescricao))) = 1 Then
InfoMarchant = InfoMarchant & "0" & Len(txtDescricao) & txtDescricao
Else
InfoMarchant = InfoMarchant & Len(txtDescricao) & txtDescricao
End If
End If
If Len(CStr(Len(InfoMarchant))) = 1 Then
MinhaLinha = MinhaLinha & "0" & Len(InfoMarchant) & InfoMarchant
Else
MinhaLinha = MinhaLinha & Len(InfoMarchant) & InfoMarchant
End If
MinhaLinha = MinhaLinha & "52040000"
MinhaLinha = MinhaLinha & "5303986"
If txtValor <> "" Then
MinhaLinha = MinhaLinha & "54"
If Len(CStr(Len(txtValor))) = 1 Then
'MsgBox Round(Len(txtValor))
MinhaLinha = MinhaLinha & "0" & Len(txtValor) & txtValor
Else
MinhaLinha = MinhaLinha & Len(txtValor) & txtValor
End If
End If
MinhaLinha = MinhaLinha & "5802BR"
MinhaLinha = MinhaLinha & "59"
If Len(CStr(Len(txtNome))) = 1 Then
MinhaLinha = MinhaLinha & "0" & Len(txtNome) & txtNome
Else
MinhaLinha = MinhaLinha & Len(txtNome) & txtNome
End If
MinhaLinha = MinhaLinha & "6008BRASILIA"
MinhaLinha = MinhaLinha & "62"
If txtId <> "" Then
ID = "05"
If Len(CStr(Len(txtId))) = 1 Then
ID = ID & "0" & Len(txtId) & txtId
Else
ID = ID & Len(txtId) & txtId
End If
If Len(CStr(Len(ID))) = 1 Then
MinhaLinha = MinhaLinha & "0" & Len(ID) & ID
Else
MinhaLinha = MinhaLinha & Len(ID) & ID
End If
Else
MinhaLinha = MinhaLinha & "070503***"
End If
MinhaLinha = MinhaLinha & "6304"
txtResultPix = MinhaLinha & crc_ccitt_ffff(CStr(MinhaLinha))
If Len(PlainText(Me.txtResultPix)) > 282 Then Exit Sub
'twebqrc = "https://chart.googleapis.com/chart?chs=250x250&cht=qr&chl=" & txtResultPix >>>> API DESCONTINUADA
twebqrc = "https://api.qrserver.com/v1/create-qr-code/?size=250x250&data=" & Me.txtResultPix '>>>> API sugerida e funcionando em 11/04/2024
Me.WB2.Navigate twebqrc
.................................................................................
Domine Access e VBA Criando Um Incrível Sistema Financeiro - [Passo a passo]
Access e VBA - Formulário Desacoplado - [Passo a passo]
Conheça meu canal no Youtube e se inscreva.