Cadastro de Clientes no Excel com VBA

Objetivo: Cadastro de clientes com consulta online do endereço através de um webservice e ainda cadastrar em uma planilha no Excel os dados do cadastro que foram cadastrados no formulário.

Para analisar as alterações criadas no VBA clique na guia Desenvolvedor->Visual Basic, as procedures criadas foram:

1. lsPesquisaCEP: Realiza a consulta dos dados do WebService de consulta de CEP.

2. lsAdiciona: Adiciona os dados cadastrados no formulário de clientes.

Sub lsPesquisaCEP(ByVal sCEP As String) On Error GoTo TratarErro Range("Consulta!a1:H1").Clear If sCEP <> "" Then With ActiveWorkbook.XmlMaps("webservicecep_Mapa") .ShowImportExportValidationErrors = False .AdjustColumnWidth = True .PreserveColumnFilter = False .PreserveNumberFormatting = False .AppendOnImport = False End With ActiveWorkbook.XmlImport URL:= _ "http://republicavirtual.com.br/web_cep.php?cep=" & sCEP, ImportMap:= _ Nothing, Overwrite:=False, Destination:=Range("Consulta!$a$1") End If Calculate Sair: Exit Sub TratarErro: MsgBox "CEP não cadastrado!" GoTo Sair Resume End Sub

Sub lsAdiciona() Dim iTotalLinhas As Integer Worksheets("Banco").Activate Range("Banco!$A$1").Select iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(iTotalLinhas, 1).Value = Range("Banco!$L$1").Value + 1 Cells(iTotalLinhas, 2).Value = UCase(Range("Formulario!E7").Value) 'nome Cells(iTotalLinhas, 3).Value = Range("Formulario!E9").Value 'cep Cells(iTotalLinhas, 4).Value = UCase(Range("Formulario!E11").Value) 'tipo Cells(iTotalLinhas, 5).Value = UCase(Range("Formulario!G11").Value) 'logradouro Cells(iTotalLinhas, 6).Value = Range("Formulario!M11").Value 'número Cells(iTotalLinhas, 7).Value = UCase(Range("Formulario!E13").Value) 'bairro Cells(iTotalLinhas, 8).Value = UCase(Range("Formulario!E15").Value) 'cidade Cells(iTotalLinhas, 9).Value = UCase(Range("Formulario!M15").Value) 'uf Worksheets("Formulario").Activate Range("Formulario!E7").Value = "" 'nome Range("Formulario!E9").Value = "" 'cep Range("Formulario!M11").Value = "" 'número End Sub

Marcos Rieper

Baixe a planilha