Autor: admin

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

Gerar IE – SP

Função Geradora de Inscrição Estadual (IE) em VBA

Gerar números válidos de Inscrição Estadual (IE) de forma aleatória é uma tarefa complexa, pois cada estado do Brasil tem sua própria regra de formação e validação, incluindo dígitos verificadores específicos. Devido a essa complexidade, seria impraticável fornecer um código único que cubra todos os estados. No entanto, posso fornecer um exemplo básico para um estado específico. Vou escolher São Paulo como exemplo, mas tenha em mente que esta função não será aplicável para outros estados e a validação real de uma IE é mais complexa e deve ser feita utilizando as regras específicas de cada estado. Aqui está um exemplo de função em VBA para gerar Inscrição Estadual fictícia para o estado de São Paulo: 

Function GerarIESaoPaulo() As String
    Dim BaseIE As String
    Dim Digito1 As Integer
    Dim Digito2 As Integer
    Dim i As Integer
    Dim soma As Integer

    Randomize

    ' Gerar os primeiros 8 dígitos de forma aleatória
    For i = 1 To 8
        BaseIE = BaseIE & Int(Rnd * 10)
    Next i

    ' Cálculo do primeiro dígito verificador
    soma = 0
    For i = 1 To 8
        If i = 1 Or i = 7 Then
            soma = soma + Val(Mid(BaseIE, i, 1)) * 1
        Else
            soma = soma + Val(Mid(BaseIE, i, 1)) * i
        End If
    Next i
    Digito1 = soma Mod 10

    ' Cálculo do segundo dígito verificador
    soma = 0
    For i = 1 To 8
        soma = soma + Val(Mid(BaseIE, i, 1)) * (i + 1)
    Next i
    soma = soma + Digito1 * 2
    Digito2 = soma Mod 10

    ' Combinar os números e os dígitos verificadores
    GerarIESaoPaulo = BaseIE & "-" & Digito1 & Digito2
End Function

Sub ImprimirInscricoesEstaduais()
    Dim i As Integer
    Dim IE As String

    ' Configurar a coluna A
    With Range("A:A")
        .NumberFormat = "@"
        .Font.Size = 14
    End With

    ' Gerar e imprimir 10 Inscrições Estaduais
    For i = 1 To 10
        IE = GerarIESaoPaulo()
        Cells(i, 1).Value = IE
    Next i
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

Gerar CEPs

Função Geradora de CEPs em VBA

Para criar uma função em VBA que gera números válidos de CEP (Código de Endereçamento Postal do Brasil) e os imprime a partir da célula A1 com tamanho de fonte 14 e no formato texto, podemos seguir uma abordagem mais simples, já que o CEP é basicamente um conjunto de 8 dígitos, geralmente formatado como XXXXX-XXX. Não há um dígito verificador ou um cálculo complexo envolvido na geração de um CEP.


Function GerarCEPAleatorio() As String
    Dim Parte1 As Long
    Dim Parte2 As Long

    Randomize

    ' Gerar as duas partes do CEP
    Parte1 = Int((99999 - 10000 + 1) * Rnd + 10000) ' Gera um número entre 10000 e 99999
    Parte2 = Int((999 - 100 + 1) * Rnd + 100)      ' Gera um número entre 100 e 999

    ' Combinar as partes para formar o CEP
    GerarCEPAleatorio = Format(Parte1, "00000") & "-" & Format(Parte2, "000")
End Function

Sub ImprimirCEPs()
    Dim i As Integer
    Dim CEP As String

    ' Configurar a coluna A
    With Range("A:A")
        .NumberFormat = "@"
        .Font.Size = 14
    End With

    ' Gerar e imprimir 10 CEPs
    For i = 1 To 10
        CEP = GerarCEPAleatorio()
        Cells(i, 1).Value = CEP
    Next i
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

Gerar RGs

Função Geradora de RGs em VBA

Criar uma função em VBA para gerar números válidos de RG (Registro Geral) é um pouco mais complexo do que simplesmente gerar números aleatórios, pois o RG possui um dígito verificador que depende dos outros números do documento. Além disso, o formato do RG pode variar dependendo do estado brasileiro. Aqui, vou fornecer um exemplo que gera um RG no formato mais comum, sem considerar as variações estaduais. 

Function GerarRGAleatorio() As String
    Dim rg As String
    Dim soma As Integer
    Dim i As Integer
    Dim resto As Integer
    Dim digito As String

    Randomize

    ' Gerar os primeiros 8 dígitos do RG de forma aleatória
    For i = 1 To 8
        rg = rg & Int(Rnd * 10)
    Next i

    ' Calculando o dígito verificador
    For i = 1 To 8
        soma = soma + Val(Mid(rg, i, 1)) * (9 - (i - 1))
    Next i

    resto = soma Mod 11
    If resto = 10 Then
        digito = "X"
    Else
        digito = CStr(resto)
    End If

    ' Combinar os números e o dígito verificador
    GerarRGAleatorio = rg & "-" & digito
End Function

Sub ImprimirRGs()
    Dim i As Integer
    Dim rg As String

    ' Configurar a coluna A
    With Range("A:A")
        .NumberFormat = "@"
        .Font.Size = 14
    End With

    ' Gerar e imprimir 10 RGs
    For i = 1 To 10
        rg = GerarRGAleatorio()
        Cells(i, 1).Value = rg
    Next i
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

Gerar Mega Sena

Função Geradora de Mega Sena em VBA

Para criar uma função em VBA que gere números aleatórios da Mega Sena e os imprima a partir da célula A1 com tamanho de fonte 14 e no formato texto, você pode utilizar o seguinte código. A Mega Sena consiste na escolha de 6 números únicos de 1 a 60, então este código irá gerar tais combinações. 

Function GerarNumerosMegaSena() As String
    Dim Numeros(1 To 6) As Integer
    Dim i As Integer, j As Integer
    Dim Num As Integer
    Dim Resultado As String

    Randomize

    ' Gerar 6 números únicos
    For i = 1 To 6
        Do
            Num = Int((60 * Rnd) + 1)
            ' Verificar se o número já foi escolhido
            For j = 1 To i - 1
                If Numeros(j) = Num Then
                    Num = 0
                    Exit For
                End If
            Next j
        Loop While Num = 0
        Numeros(i) = Num
    Next i

    ' Ordenar os números
    Call BubbleSort(Numeros)

    ' Converter para string
    For i = 1 To 6
        Resultado = Resultado & Format(Numeros(i), "00") & " "
    Next i

    GerarNumerosMegaSena = Trim(Resultado)
End Function

' Função auxiliar para ordenar os números
Sub BubbleSort(ByRef Arr() As Integer)
    Dim i As Integer, j As Integer
    Dim Temp As Integer

    For i = UBound(Arr) To 2 Step -1
        For j = 1 To i - 1
            If Arr(j) > Arr(j + 1) Then
                Temp = Arr(j)
                Arr(j) = Arr(j + 1)
                Arr(j + 1) = Temp
            End If
        Next j
    Next i
End Sub

Sub ImprimirNumerosMegaSena()
    Dim i As Integer
    Dim Numeros As String

    ' Configurar a coluna A
    With Range("A:A")
        .NumberFormat = "@"
        .Font.Size = 14
    End With

    ' Gerar e imprimir 10 conjuntos de números
    For i = 1 To 10
        Numeros = GerarNumerosMegaSena()
        Cells(i, 1).Value = Numeros
    Next i
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

Gerar Nomes

Função Geradora de Nomes em VBA

Para criar uma função em VBA que gera nomes e dois sobrenomes aleatórios e imprime a partir da célula A1 com tamanho de fonte 14 e no formato texto, você pode utilizar o seguinte código. Este código vai gerar nomes e sobrenomes de uma lista pré-definida, então você pode ajustar as listas de acordo com suas preferências. 

Function GerarNomeAleatorio() As String
    Dim Nomes As Variant
    Dim Sobrenomes As Variant
    Dim NomeAleatorio As String
    Dim Sobrenome1 As String
    Dim Sobrenome2 As String

    ' Listas de nomes e sobrenomes
    Nomes = Array("Ana", "João", "Maria", "José", "Luís", "Paula", "Carlos", "Sofia")
    Sobrenomes = Array("Silva", "Santos", "Oliveira", "Pereira", "Souza", "Rodrigues", "Fernandes", "Gonçalves")

    Randomize

    ' Selecionar aleatoriamente um nome e dois sobrenomes
    NomeAleatorio = Nomes(Int((UBound(Nomes) + 1) * Rnd))
    Sobrenome1 = Sobrenomes(Int((UBound(Sobrenomes) + 1) * Rnd))
    Sobrenome2 = Sobrenomes(Int((UBound(Sobrenomes) + 1) * Rnd))

    ' Combinar para formar um nome completo
    GerarNomeAleatorio = NomeAleatorio & " " & Sobrenome1 & " " & Sobrenome2
End Function

Sub ImprimirNomes()
    Dim i As Integer
    Dim NomeCompleto As String

    ' Configurar a coluna A
    With Range("A:A")
        .NumberFormat = "@"
        .Font.Size = 14
    End With

    ' Gerar e imprimir 10 nomes
    For i = 1 To 10
        NomeCompleto = GerarNomeAleatorio()
        Cells(i, 1).Value = NomeCompleto
    Next i
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