Ir para conteúdo
Fórum Script Brasil

Regis Junior

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre Regis Junior

  • Data de Nascimento 12/05/1970

Contatos

  • MSN
    reg@extranetinfo.com.br

Perfil

  • Gender
    Male
  • Location
    São Paulo

Regis Junior's Achievements

0

Reputação

  1. Regis Junior

    VBA em Acess

    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
×
×
  • Criar Novo...