Etiqueta: Log

Remove Caracteres

Função que remove os caracteres não numéricos

Função para remover caracteres não numéricos de um texto.


Sub teste()

    Range("A2").Value2 = RemoveCaracterNaoNumericos(Range("A1").Value2)
End Sub


Function RemoveCaracterNaoNumericos(ByVal AlphaNum As Variant) As String
         Dim Clean As String
         Dim Pos, A_Char$

         Pos = 1
         If IsNull(AlphaNum) Then Exit Function

         For Pos = 1 To Len(AlphaNum)
            A_Char$ = Mid(AlphaNum, Pos, 1)
            If A_Char$ >= "0" And A_Char$ <= "9" Then
              Clean$ = Clean$ + A_Char$
            End If
         Next Pos

         RemoveCaracterNaoNumericos = Clean$

End Function

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Meu IP

API Meu IP em VBA

Imagem centralizada

Para consultar o seu IP público atual usando VBA, você pode utilizar APIs externas que fornecem esse serviço. Uma das APIs mais simples para essa finalidade é a “http://api.ipify.org“, que retorna o IP público do usuário que fez a solicitação. Este serviço é gratuito e não requer uma chave API.




Function ConsultarIPAtual() As String
    Dim httpObject As Object
    Set httpObject = CreateObject("MSXML2.XMLHTTP")

    ' URL da API ipify
    Dim url As String
    url = "http://api.ipify.org"

    ' Enviar uma solicitação GET
    httpObject.Open "GET", url, False
    httpObject.Send

    ' Verificar se a solicitação foi bem-sucedida
    If httpObject.Status = 200 Then
        ' Retorna o IP atual
        ConsultarIPAtual = httpObject.responseText
    Else
        ' Retorna uma mensagem de erro
        ConsultarIPAtual = "Erro na solicitação: " & httpObject.Status
    End If

    Set httpObject = Nothing
End Function

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

CEPs

API CEPs em VBA

Chamar uma API externa para consultar os CEPs de uma cidade usando VBA pode ser realizado através de APIs públicas disponíveis. Uma das APIs que você pode usar para este propósito é a ViaCEP, que permite consultar informações de CEPs no Brasil. 



Function ConsultarCEPsPorCidade(CEP As String) As String
    Dim httpObject As Object
    Set httpObject = CreateObject("MSXML2.XMLHTTP")

    Dim url As String
    url = "https://viacep.com.br/ws/" & CEP & "/json/"

    httpObject.Open "GET", url, False
    httpObject.Send

    If httpObject.Status = 200 Then
        ConsultarCEPsPorCidade = httpObject.responseText
    Else
        ConsultarCEPsPorCidade = "Erro na solicitação: " & httpObject.Status
    End If

    Set httpObject = Nothing
End Function

Sub ProcessarRespostaJSON()
    Dim CEP As String
    Dim resposta As String
    Dim linhas() As String
    Dim partes() As String
    Dim linha As String
    Dim i As Integer

    CEP = ThisWorkbook.Sheets(1).Range("A1").Value

    resposta = ConsultarCEPsPorCidade(CEP)

    ' Quebrar a resposta em linhas (cada CEP)
    linhas = Split(resposta, "},{")

    ' Processar cada linha
    For i = LBound(linhas) To UBound(linhas)
        linha = linhas(i)
        linha = Replace(linha, "{", "")
        linha = Replace(linha, "}", "")
        linha = Replace(linha, """", "")
        linha = Replace(linha, "[", "")
        linha = Replace(linha, "]", "")

        partes = Split(linha, ",")
        
        ' Atribuir os valores nas células
        ThisWorkbook.Sheets(1).Cells(1 + 3, 1).Value = ExtrairValorJSON(partes, "cep")
        ThisWorkbook.Sheets(1).Cells(2 + 3, 1).Value = ExtrairValorJSON(partes, "logradouro")
        ThisWorkbook.Sheets(1).Cells(3 + 3, 1).Value = ExtrairValorJSON(partes, "complemento")
        ThisWorkbook.Sheets(1).Cells(4 + 3, 1).Value = ExtrairValorJSON(partes, "bairro")
        ThisWorkbook.Sheets(1).Cells(5 + 3, 1).Value = ExtrairValorJSON(partes, "localidade")
        ThisWorkbook.Sheets(1).Cells(6 + 3, 1).Value = ExtrairValorJSON(partes, "uf")
        ThisWorkbook.Sheets(1).Cells(7 + 3, 1).Value = ExtrairValorJSON(partes, "ibge")
        ThisWorkbook.Sheets(1).Cells(8 + 3, 1).Value = ExtrairValorJSON(partes, "gia")
        ThisWorkbook.Sheets(1).Cells(9 + 3, 1).Value = ExtrairValorJSON(partes, "ddd")
        ThisWorkbook.Sheets(1).Cells(10 + 3, 1).Value = ExtrairValorJSON(partes, "saifi")
    Next i
End Sub

Function ExtrairValorJSON(partes() As String, chave As String) As String
    Dim parte As Variant
    For Each parte In partes
        If InStr(parte, chave) > 0 Then
            ExtrairValorJSON = Trim(Split(parte, ":")(1))
            Exit Function
        End If
    Next parte
    ExtrairValorJSON = ""
End Function
Cole o código no módulo que você criou no Editor do VBA. Insira o nome da cidade na célula A1 e a sigla do estado na célula A2. Execute a sub-rotina ConsultarCEPs. Este exemplo faz uma solicitação GET para a API ViaCEP e retorna os dados em formato JSON, que será exibido na célula A3. Dependendo do volume de dados, você pode precisar de um processamento adicional para extrair e formatar as informações de maneira adequada para a sua necessidade.

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Calculadora

Calculadora Simples em VBA

Criar uma calculadora simples no Excel usando VBA envolve definir algumas funções básicas de matemática (como adição, subtração, multiplicação e divisão) e configurar as células do Excel para usar essas funções. Abaixo, vou fornecer um exemplo de como você pode estruturar isso.

No exemplo, vamos supor que:

  • A célula A1 conterá o primeiro número.
  • A célula A2 conterá o segundo número.
  • A célula A3 conterá a operação (por exemplo, “+”, “-“, “*”, “/”).
  • A célula A4 exibirá o resultado.

Primeiro, crie as funções básicas:



Function Somar(a As Double, b As Double) As Double
    Somar = a + b
End Function

Function Subtrair(a As Double, b As Double) As Double
    Subtrair = a - b
End Function

Function Multiplicar(a As Double, b As Double) As Double
    Multiplicar = a * b
End Function

Function Dividir(a As Double, b As Double) As Double
    If b <> 0 Then
        Dividir = a / b
    Else
        Dividir = "Erro: Divisão por zero"
    End If
End Function

Sub Calcular()
    Dim num1 As Double
    Dim num2 As Double
    Dim operacao As String
    Dim resultado As Variant

    ' Lê os valores das células
    num1 = ThisWorkbook.Sheets(1).Range("A1").Value
    num2 = ThisWorkbook.Sheets(1).Range("A2").Value
    operacao = ThisWorkbook.Sheets(1).Range("A3").Value

    ' Determina a operação a ser realizada
    Select Case operacao
        Case "+"
            resultado = Somar(num1, num2)
        Case "-"
            resultado = Subtrair(num1, num2)
        Case "*"
            resultado = Multiplicar(num1, num2)
        Case "/"
            resultado = Dividir(num1, num2)
        Case Else
            resultado = "Operação inválida"
    End Select

    ' Exibe o resultado na célula A4
    ThisWorkbook.Sheets(1).Range("A4").Value = resultado
End Sub
  1. Abra o Excel e pressione ALT + F11 para abrir o Editor do VBA.
    No menu “Inserir”, escolha “Módulo” para criar um novo módulo.
    Cole o código das funções e da sub-rotina no módulo.
  2. No Excel, digite os dois números nas células A1 e A2, e a operação desejada (+, -, *, /) na célula A3.
    Execute a sub-rotina Calcular para ver o resultado na célula A4.
    Este é um exemplo básico de como você pode criar uma calculadora simples no Excel usando VBA. Você pode expandir ou modificar este exemplo conforme necessário para incluir mais funcionalidades.

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

IMC

Função IMC em VBA

Para criar uma função em VBA que calcula o Índice de Massa Corporal (IMC), considerando que o peso está na célula A1, a altura na célula A2 e que o resultado deve ser colocado na célula A4, você pode usar o seguinte código. Este código assume que o peso está em quilogramas e a altura em metros.


Sub CalcularIMC()
    Dim peso As Double
    Dim altura As Double
    Dim imc As Double

    ' Lê o peso da célula A1 e a altura da célula A2
    peso = ThisWorkbook.Sheets(1).Range("A1").Value
    altura = ThisWorkbook.Sheets(1).Range("A2").Value

    ' Verifica se os valores são maiores que zero para evitar divisão por zero
    If peso > 0 And altura > 0 Then
        ' Calcula o IMC
        imc = peso / (altura * altura)

        ' Coloca o resultado na célula A4
        ThisWorkbook.Sheets(1).Range("A4").Value = imc
    Else
        ThisWorkbook.Sheets(1).Range("A4").Value = "Valores inválidos"
    End If
End Sub

Abra o Excel e pressione ALT + F11 para abrir o Editor do VBA.
No menu “Inserir”, escolha “Módulo” para criar um novo módulo.
Cole o código acima no módulo.
Execute a sub-rotina CalcularIMC com o peso na célula A1 e a altura na célula A2 da primeira planilha.
O IMC é calculado dividindo o peso (em quilogramas) pelo quadrado da altura (em metros). O resultado será mostrado na célula A4. Lembre-se de que o IMC é apenas uma medida geral e pode não refletir perfeitamente a saúde ou a composição corporal de uma pessoa individual.

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Núm. Extenso

Função Números por Extenso em VBA

Criar uma função em VBA que converte números em valores por extenso pode ser um pouco complexo, devido às regras de numeração em português. Abaixo, segue uma função básica que pode converter números inteiros até 999. Se você precisar de uma função mais abrangente, que lide com números maiores e decimais, recomendo procurar uma biblioteca específica ou expandir o código.


Function NumeroPorExtenso(ByVal Numero As Integer) As String
    Dim Unidades As Variant
    Dim Dezenas As Variant
    Dim Centenas As Variant
    Dim NumExtenso As String
    Dim Resto As Integer

    ' Arrays de strings para as unidades, dezenas e centenas
    Unidades = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove")
    Dezenas = Array("", "dez", "vinte", "trinta", "quarenta", "cinquenta", "sessenta", "setenta", "oitenta", "noventa")
    Centenas = Array("", "cento", "duzentos", "trezentos", "quatrocentos", "quinhentos", "seiscentos", "setecentos", "oitocentos", "novecentos")

    ' Verificar centenas
    If Numero = 100 Then
        NumExtenso = "cem"
    Else
        NumExtenso = Centenas(Numero \ 100)
    End If

    Resto = Numero Mod 100

    ' Verificar dezenas
    If Resto >= 10 And Resto <= 19 Then
        NumExtenso = NumExtenso & " " & Array("dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", "dezoito", "dezenove")(Resto - 10)
    Else
        NumExtenso = NumExtenso & " " & Dezenas(Resto \ 10)
        Resto = Resto Mod 10
    End If

    ' Verificar unidades
    NumExtenso = NumExtenso & " " & Unidades(Resto)

    ' Remover espaços extras
    NumeroPorExtenso = Trim(Replace(NumExtenso, "  ", " "))
End Function

Sub ConverterNumeroPorExtenso()
    Dim Numero As Integer
    Dim Extenso As String

    ' Lê o número da célula A1
    Numero = ThisWorkbook.Sheets(1).Range("A1").Value

    ' Converte para extenso
    Extenso = NumeroPorExtenso(Numero)

    ' Escreve o resultado na célula A2
    ThisWorkbook.Sheets(1).Range("A2").Value = Extenso
End Sub

Abra o Excel e pressione ALT + F11 para abrir o Editor do VBA.
No menu “Inserir”, escolha “Módulo” para criar um novo módulo.
Cole o código acima no módulo.
Execute a sub-rotina ConverterNumeroPorExtenso com um número na célula A1 da primeira planilha.
Este código irá ler o número da célula A1, converter para por extenso e colocar o resultado na célula A2. Note que este código é limitado a números inteiros até 999. Para números maiores ou com decimais, a função precisaria ser significativamente expandida.

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Meu IP Local

Função Meu IP Localizador em VBA

Obter o endereço IP e sua localização usando apenas VBA é um pouco mais complexo, pois o VBA não possui funcionalidades nativas para determinar a localização geográfica de um endereço IP. No entanto, você pode usar VBA para fazer uma solicitação a um serviço web externo que fornece tanto o IP quanto a localização. Um exemplo de serviço que oferece isso é o ip-api.com.


Sub ObterIPeLocalizacao()
    Dim httpObject As Object
    Set httpObject = CreateObject("MSXML2.XMLHTTP")

    ' Enviar uma solicitação para o serviço que retorna o endereço IP e a localização
    httpObject.Open "GET", "http://ip-api.com/json", False
    httpObject.Send

    ' Verificar se a solicitação foi bem-sucedida
    If httpObject.Status = 200 Then
        Dim resposta As String
        resposta = httpObject.responseText

        ' Usar uma função para extrair o IP e a localização do JSON
        Dim IP As String, cidade As String, regiao As String, pais As String
        IP = ExtrairValorJSON(resposta, "query")
        cidade = ExtrairValorJSON(resposta, "city")
        regiao = ExtrairValorJSON(resposta, "regionName")
        pais = ExtrairValorJSON(resposta, "country")

        ' Escrever o resultado na célula A1
        ThisWorkbook.Sheets(1).Range("A1").Value = "IP: " & IP & " - Localização: " & cidade & ", " & regiao & ", " & pais
    Else
        ThisWorkbook.Sheets(1).Range("A1").Value = "Não foi possível obter as informações"
    End If

    Set httpObject = Nothing
End Sub

Function ExtrairValorJSON(jsonString As String, chave As String) As String
    Dim inicio As Integer, fim As Integer
    chave = """" & chave & """:"""
    inicio = InStr(jsonString, chave)
    If inicio > 0 Then
        inicio = inicio + Len(chave)
        fim = InStr(inicio, jsonString, """")
        ExtrairValorJSON = Mid(jsonString, inicio, fim - inicio)
    Else
        ExtrairValorJSON = ""
    End If
End Function

Abra o Excel e pressione ALT + F11 para abrir o Editor do VBA.
No menu “Inserir”, escolha “Módulo” para criar um novo módulo.
Cole o código acima no módulo.
Execute a sub-rotina ObterIPeLocalizacao.
Este código faz uma solicitação ao ip-api.com, que retorna um JSON com informações sobre o IP, incluindo localização (cidade, região e país). A função ExtrairValorJSON é usada para obter esses dados do JSON. O resultado é então escrito na célula A1 da primeira folha.
Note que este método depende de um serviço web externo, que pode ter limitações de uso (como um número máximo de solicitações gratuitas por minuto) e pode não funcionar se o computador estiver atrás de um firewall ou proxy que bloqueie a solicitação HTTP. Além disso, os dados de localização podem não ser precisos para todos os IPs

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Meu IP

Função Meu IP em VBA

Obter o endereço IP público do seu computador usando apenas VBA pode ser um desafio, pois o VBA não tem funções internas para fazer isso diretamente. No entanto, você pode usar VBA para fazer uma solicitação a um serviço web externo que retorna seu IP público. Uma das maneiras de fazer isso é usando o objeto Microsoft.XMLHTTP para enviar uma solicitação a um serviço como http://api.ipify.org.


Sub ObterEnderecoIP()
    Dim httpObject As Object
    Set httpObject = CreateObject("MSXML2.XMLHTTP")

    ' Enviar uma solicitação para o serviço que retorna o endereço IP público
    httpObject.Open "GET", "http://api.ipify.org", False
    httpObject.Send

    ' Verificar se a solicitação foi bem-sucedida
    If httpObject.Status = 200 Then
        ' Escrever o endereço IP na célula A1
        ThisWorkbook.Sheets(1).Range("A1").Value = httpObject.responseText
    Else
        ThisWorkbook.Sheets(1).Range("A1").Value = "Não foi possível obter o IP"
    End If

    Set httpObject = Nothing
End Sub

Abra o Excel e pressione ALT + F11 para abrir o Editor do VBA.
No menu “Inserir”, escolha “Módulo” para criar um novo módulo.
Cole o código acima no módulo.
Execute a sub-rotina ObterEnderecoIP.
Este código faz uma solicitação ao site http://api.ipify.org, que simplesmente retorna o endereço IP público do solicitante. O endereço IP é então escrito na célula A1 da primeira folha.

Lembre-se de que este método depende de um serviço web externo e pode não funcionar se o computador estiver atrás de um firewall ou proxy que bloqueie a solicitação HTTP. Além disso, isso retornará o IP público, que pode ser o mesmo para todos os dispositivos na mesma rede local.

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Base64 Decode

Função Base64 Decode em VBA

Para criar uma função em VBA que decodifica um valor em Base64 da célula A1 e coloca o resultado na célula A2, você pode usar o seguinte código. Esta função utiliza as funcionalidades de decodificação de strings do VBA para converter o texto de Base64 para o formato de texto normal. 

Function DecodificarBase64(textoBase64 As String) As String
    Dim objXML As Object
    Dim objNode As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")

    objNode.DataType = "bin.base64"
    objNode.Text = textoBase64
    DecodificarBase64 = StrConv(objNode.nodeTypedValue, vbUnicode)

    Set objNode = Nothing
    Set objXML = Nothing
End Function

Sub ConverterDeBase64()
    Dim textoBase64 As String
    Dim textoDecodificado As String

    textoBase64 = ThisWorkbook.Sheets(1).Range("A1").Value
    textoDecodificado = DecodificarBase64(textoBase64)
    ThisWorkbook.Sheets(1).Range("A2").Value = textoDecodificado
End Sub

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com

Base64 Encode

Função Base64 Encode em VBA

Para criar uma função em VBA que codifica o valor da célula A1 em Base64 e coloca o resultado na célula A2, você pode usar o seguinte código. Esta função utiliza as funcionalidades de codificação de string do VBA para converter o texto em Base64. 

Function CodificarBase64(texto As String) As String
    Dim arrData() As Byte
    arrData = StrConv(texto, vbFromUnicode)

    Dim objXML As Object
    Dim objNode As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")

    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = arrData
    CodificarBase64 = objNode.Text

    Set objNode = Nothing
    Set objXML = Nothing
End Function

Sub ConverterParaBase64()
    Dim textoOriginal As String
    Dim textoBase64 As String

    textoOriginal = ThisWorkbook.Sheets(1).Range("A1").Value
    textoBase64 = CodificarBase64(textoOriginal)
    ThisWorkbook.Sheets(1).Range("A2").Value = textoBase64
End Sub

Caso queira receber esse arquivo Excel, contendo essa função, é só enviar um e-mail
solicitando para o endereço
marmitanao@gmail.com