Estou com porblemas em uma pequena aplicação do VB em Access. Criei um formulario para exportar informações de uma consulta, em certa parte desse aplicação estou utilizando o comando Replace para remover pontos, vigulas e traços dos campos dessa consulta, porém, apenas do campo CEP gostaria de manter a formatação original.
Então minha dúvida é como testar identificar o campo CEP e não executar o Replace nele?
Segue abaixo o modelo dessa aplicação
Dim gProdOrder
Option Compare Database
Private Sub cboFonte_AfterUpdate()
If Not IsNull(cboFonte) Then
Call CarregarFormatos(cboFonte)
End If
End Sub
Private Sub cboFormatoAUsar_BeforeUpdate(Cancel As Integer)
Pergunta
Regis Junior
Boa tarde pessoal tudo bem?
Estou com porblemas em uma pequena aplicação do VB em Access. Criei um formulario para exportar informações de uma consulta, em certa parte desse aplicação estou utilizando o comando Replace para remover pontos, vigulas e traços dos campos dessa consulta, porém, apenas do campo CEP gostaria de manter a formatação original.
Então minha dúvida é como testar identificar o campo CEP e não executar o Replace nele?
Segue abaixo o modelo dessa aplicação
Dim gProdOrder
Option Compare Database
Private Sub cboFonte_AfterUpdate()
If Not IsNull(cboFonte) Then
Call CarregarFormatos(cboFonte)
End If
End Sub
Private Sub cboFormatoAUsar_BeforeUpdate(Cancel As Integer)
If Not IsNull(cboFonte) Then
txtConteudoFormato = CarregarFormato(cboFonte, cboFormatoAUsar)
End If
End Sub
Private Sub cmdProcessar_Click()
GerarTXT (cboFonte)
End Sub
Private Sub cmdSalvar_Click()
If cboFonte.ListIndex < 0 Then
MsgBox "Selecione uma fonte de dados", vbExclamation
Exit Sub
End If
If Trim(txtFormatoASalvar) = "" Then
MsgBox "Informe o nome do formato", vbExclamation
Exit Sub
End If
If Trim(txtConteudoFormato) = "" Then
MsgBox "Cadastre um formato de saída", vbExclamation
Exit Sub
End If
Call CurrentDb.Execute("delete from formatos where fonte = '" & _
cboFonte & "' and formato = '" & txtFormatoASalvar & "'")
Call CurrentDb.Execute("insert into formatos (fonte, formato, conteudo) values ('" & _
cboFonte & "', '" & txtFormatoASalvar & "', '" & Replace(txtConteudoFormato, "'", "''") & "')")
End Sub
Private Sub Form_Load()
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData
For Each obj In dbs.AllQueries
If (obj.Attributes And dbSystemObject) = 0 Then
cboFonte.AddItem obj.Name
End If
Next obj
For Each obj In dbs.AllTables
If (obj.Attributes And dbSystemObject) = 0 Then
cboFonte.AddItem obj.Name
End If
Next obj
If Not IsNull(cboFonte) Then
Call CarregarFormatos(cboFonte)
End If
End Sub
Private Sub CarregarFormatos(ByVal fonte As String)
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("select * from formatos where fonte = '" & fonte & "' order by formato")
Do While Not rs.EOF
cboFormatoAUsar.AddItem rs!formato
rs.MoveNext
Loop
End Sub
Private Function CarregarFormato(ByVal fonte As String, ByVal formato As String) As String
Dim rs As DAO.Recordset
CarregarFormato = ""
Set rs = CurrentDb.OpenRecordset("select * from formatos where fonte = '" & fonte & "' and formato = '" & formato & "' order by formato")
Do While Not rs.EOF
CarregarFormato = rs!conteudo
Exit Function
Loop
End Function
Private Function GerarTXT(ByVal fonte As String)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs(fonte)
For intI = 0 To qdf.Parameters.Count - 1
Set prm = qdf.Parameters(intI)
prm.Value = InputBox("Valor para " & prm.Name)
Next intI
Set rst = qdf.OpenRecordset()
Set fso = CreateObject("Scripting.FileSystemObject")
'Caso tenha problema com permissão, basta alterar o diretorio aqui
Set ts = fso.CreateTextFile("C:\arquivo.txt", True)
linha = ""
Do While Not rst.EOF
colunasFormatos = Split(txtConteudoFormato, vbCrLf)
For i = LBound(colunasFormatos) To UBound(colunasFormatos)
fmtColuna = Split(colunasFormatos(i), ";")
Valor = rst.Fields(fmtColuna(0)).Value 'Nome da Coluna ou Expressão
formato = fmtColuna(1) 'Formatação a aplicar na Coluna
If Not IsNull(Valor) Then
Select Case formato:
Case "Inteiro"
If IsNumeric(Valor) Then
Valor = Replace(Replace(Replace(Valor, ",", ""), ".", ""), "-", "")
Else
MsgBox "Valor incompatível com o formato aplicado. Valor esperado: " & formato & ", Valor atual da coluna " & fmtColuna(0) & " é " & Valor
End If
Case "Decimal"
If IsNumeric(Valor) Then
Valor = Replace(Replace(Replace(Valor, ",", ""), ".", ""), "-", "")
Else
MsgBox "Valor incompatível com o formato aplicado. Valor esperado: " & formato & ", Valor atual da coluna " & fmtColuna(0) & " é " & Valor
End If
Case "Texto"
Valor = Replace(Replace(Replace(Valor, ",", ""), ".", ""), "-", "")
End Select
End If
tamanho = fmtColuna(2) 'Tamanho da Coluna
alinhamento = fmtColuna(3) 'Alinhamento da Coluna
Select Case alinhamento:
Case "direita":
Valor = Right(String(tamanho, " ") & Valor, tamanho)
Case "esquerda":
Valor = Left(Valor & String(tamanho, " "), tamanho)
End Select
linha = linha & Valor
Next i
linha = linha & vbCrLf
rst.MoveNext
Loop
ts.write (linha)
ts.Close
MsgBox "Arquivo Gerado com Sucesso !"
End Function
Link para o comentário
Compartilhar em outros sites
1 resposta a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.