Excel VBA - Fazendo o Excel Ler um Arquivo Texto

Excel VBA - Fazendo o Excel Ler um Arquivo Texto

É importante que saibamos utilizar certas funcionalidades aparentemente pouco comuns. Quem sabe enviar pequenas mensagens aos usuários durante a espera de um processamento ou informar o andamente de uma análise o mesmo ler o resultado analítico de Dashboard. Use a criatividade!

Sub Speech_FromFile()

Dim Voice As SpVoice                          ' Voice Object
Dim VoiceFile As SpFileStream          ' File Stream Object
Dim File As String                                  ' File Name

Set Voice = New SpVoice
Set VoiceFile = New SpFileStream

Voice.Speak "This is an Example For Reading Out a File"

File = "C:\Documents and Settings\Administrator\My Documents\Sample.txt"

VoiceFile.Open File

Voice.SpeakStream VoiceFile

End Sub

Sub Read_Cells()
Dim x As Integer
Dim CC As Long
CC = ActiveSheet.Rows.Count
For x = 1 To CC

If Cells(x, 1) <> "" Then
Cells(x, 1).Speak

End If
Next x
End Sub

Para que essa funcionalidade funcione não se esqueça de referenciar a respectiva biblioteca abaixo:

Deixe seus comentários, compartilhe este artigo!

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Brazil Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com

Excel VBA - Consolidando Múltiplas Células em uma única Célula de Múltiplas Linhas - Consolidate Data from Different Cells into a Single Cell in Multiple Lines

Excel VBA - Consolidando Múltiplas Células em uma única Célula de Múltiplas Linhas - Consolidate Data from Different Cells into a Single Cell in Multiple Lines

Como consolidar dados de células diferentes em uma única célula em múltiplas linhas do Excel? Suponha que o endereço de um funcionário esteja atualmente dividido em diferentes células e você deseje consolidá-los numa única célula em várias linhas. Usaremos a função CHAR do Excel da seguinte maneira: 

O endereço das células acima estão divididos na células de A2 a E2 and e a fórmula abaixo consolidará e formatará numa célula simples com múltiplas linhas.

=A2&CHAR(10)&B2&"-"&C2&CHAR(10)&D2&"-"&E2

Aqui,10 é o código ANSI para um [ENTER] e mudança de linha, provendo a adequada quebra da linha dentro da célula.

Resultado:

Suponha que deseje formatar o Endereço sem a quebra de linha, apenas separando as informações por uma vírgula, use a fórmula abaixo: 

=SUBSTITUTE(C3,CHAR(10),", ") 

Deixe seus comentários, compartilhe este artigo!

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Brazil Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com

Excel VBA - Obtendo o Endereço de Referência das células de um Range - How to Get the Cell Address of a Matching Column and Row in Excel

Excel VBA - Obtendo o Endereço de Referência das células de um Range - How to Get the Cell Address of a Matching Column and Row in Excel

Esta função do Excel permite obter o endereço correspondente das colunas e linhas na planilha Excel da guia de origem, como a seguir:

Endereço dos Campos (células) na fonte:
 =(ADDRESS(1,MATCH(A2,Data!$A$1:$AH$1,0),1))

Campo (célula) número da LINHA:
 =MID(B2,FIND("$",B2,2)+1,LEN(B2)-FIND("$",B2,2))

Campo (célula) número da COLUNA:
 =MATCH(A2,Data!$A$1:$AH$1,0)

Campo (célula) nome do índice da coluna:
 =LEFT(B2,FIND("$",B2,2)-1)

Deixe seus comentários, compartilhe este artigo!

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Brazil Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com

Excel VBA - Inserindo o conteúdo de um Range num ComboBox ActiveX

Inserindo o conteúdo de um Range num ComboBox ActiveX

Este código VBA adicionará o conteúdo do intervalo da planilha Excel no ComboBox ActiveX com DropButtonClick

Private Sub Cmb_FiscQtr_DropButtonClick()

    Dim WS As Worksheet

    Dim r As Long

    Dim n As Long

    Dim x As Long

    Dim y As Long

    

    Dim OLE_Obj As Object    

    Dim FQ_Items() As Variant

    Set WS = Worksheets("Test")

    Set OLE_Obj = WS.OLEObjects("Cmb_FiscQtr").Object

    On Error Resume Next

'O Range onde estão os valores      

    Let x = WS.Range("F65536").End(xlUp).Row

'Redimensionando o tamanho do Array

    ReDim FQ_Items(1 To x - 9)

'Adicioando os trimestres fiscais do range no Combobox        

    Let FQ_Items(1) = "(All)"

    Let n = 2

    For r = 11 To x

        Let FQ_Items(n) = WS.Cells(r, 6).Value

        Let n = n + 1

    Next r

    Let Cmb_FiscQtr.List = FQ_Items

    

 'Mostrando os itens no Combox Box

    Let y = OLE_Obj.ListCount

    For x = 0 To (y - 1)

    Let OLE_Obj.ListIndex = x

    MsgBox OLE_Obj.List(x)

    Next x

    

'Deletando os Itens do Arrary

    Erase FQ_Items

    Set WS = Nothing

End Sub

Deixe seus comentários, compartilhe este artigo!

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Brazil Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com

Excel VBA - Como Enviar um Range de uma planilha pelo Outlook - How to Send a Range from an Active Sheet in an Outlook Email Body from Active Workbook with VBA

Excel VBA - Como Enviar um Range de uma planilha pelo Outlook - How to Send a Range from an Active Sheet in an Outlook Email Body from Active Workbook with VBA

Este código envia o conteúdo de um Range no corpo do e-mail do Outlook.

Sub Mail_Selection_Range_Outlook_Body()
    Dim Rng As Range
    Dim OutlookApp As Object
    Dim NewMail As Object

    Set Rng = Nothing
    On Error Resume Next

    Set Rng = ActiveSheet.Range("MyRng")
'--Se desejar, pode utilizarum Range fixo
    'Set Rng = Sheets("YourSheet").Range("A1:D12").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If Rng Is Nothing Then
        MsgBox "Não foi realizada a seleção de um Range ou a Planilha está protegida." & _
               vbNewLine & "Por favor, corrija e comece novamente.", vbOKOnly
        Exit Sub
    End If

    With Application
        Let .EnableEvents = False
        Let .ScreenUpdating = False
    End With

    Set OutlookApp = CreateObject("Outlook.Application")
    Set NewMail = OutlookApp.CreateItem(olMailItem)
    'Set NewMail = OutlookApp.CreateItem(0)
    
 '--Inserindo uma assinatura no corpo do Email
 '--Mude somente 'YourSignature.htm' no nome da sua assinatura
    Let SigString = Environ("appdata") & "\Microsoft\Signatures\Tamatam.htm"

    If Dir(SigString) <> "" Then
        Let Signature = GetBoiler(SigString)
    Else
        Let Signature = ""
    End If

 '--Selecione a conta de Email de onde deseja enviar
 '--Caso sua conta não seja seu perfil, precisará usar SentOnBehalfOfName
        For I = 1 To OutlookApp.Session.Accounts.Count
            If OutlookApp.Session.Accounts.Item(I) = "MyEmailAccountAlias@Domain.Com" Then
             MsgBox OutlookApp.Session.Accounts.Item(I) & " : This is account number " & I
                Let Acn_No = I
                Exit For
            End If
        Next I

'--Definindo o corpo do Email
        Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
                    "Este é um exemplo teste de envio de email por código VBA<br>" & _
                    "Por favor não o responda<br>" & _
                    "<A href=""http://brzexceldeveloper.blogspot.com.br//"">✔ Brazil VBA Excel Specialist®</A>"
              
    On Error Resume Next

'--Abre um novo Email para envio
    With NewMail
        Let .TO= "YourEmail@Domain.com" '-- O Email de destino é digitado aqui
        Let .CC = ""
        Let .Subject = "Test Message" '--O assunto do Email é colocado aqui
       'Let .Body = "This Your Email Boday ; '--Pode colocar este código abaixo também
        Let .HTMLBody = Strbody & "<br>" & "<br>" & _
                    RangetoHTML(Rng) & "<br>" & "<br>" & _
                    "<B>Obrigado</B>" & "<br>" & "<br>" & Signature
        Let .SentOnBehalfOfName = OutlookApp.Session.Accounts.Item(Acn_No) 

        '--Poderá usar este código abaixo como desejar
        'Let .SentOnBehalfOfName = "MyEmailAccountAlias@Domain.Com"
        'Let .SendUsingAccount = OutlookApp.Session.Accounts.Item(Acn_No)

        Let .Display '--Mostre o email antes de enviá-lo, se desejar.
        Let .BCC = "brazilsalesforceeffectiveness@gmail.com"
        Let .Send
    End With
    
    On Error GoTo 0

    With Application
        Let .EnableEvents = True
        Let .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

A função abaixo criará um arquivo temporário contendo o Range da planilha ativa como um arquivo .htm, colocando-o a seguir no corpo do Email da mensagem

Function RangetoHTML(Rng As Range)
    Dim FSO As Object
    Dim TS As Object
    Dim TempFile As String
    Dim TempWB As Workbook

'--Criando um arquivo .htm temporário para copiar o Range da planilha ativa.
    'Let TempFile = Environ$("temp") & "\" & Format(Now, "dd-mmm-yyyy") & ".htm"
     Let TempFile = Environ("UserProfile") & "\Desktop\Test\" & Format(Now, "dd-mmm-yyyy") 
                                                                                              & ".htm"

 '--Copia e cola o range com os dados para uma nova planilha criada
    'Rng.Select
    Rng.Copy
    Set TempWB = Workbooks.Add(xlWBATWorksheet)

'--Copia e cola o conteúdo do Range da planilha ativa para a planilha temporária
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8 'Paste with same Column Widths
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Let Application.CutCopyMode = False
        On Error Resume Next
        Let .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

'--Salva o conteúdo da planilha temporária como um arquivo htm temporário
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)

        .Publish (True)
    End With

 '--Lê todo o conteúdo do arquivo htm inserindo-o na variável RangetoHTML
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TS = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
    Let RangetoHTML = TS.readall
    TS.Close
    Let RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

'--Fecha o TempWB
    TempWB.Close SaveChanges:=False

'--Deleta o arquivo htm usado nesta função
    Kill TempFile

    Set TS = Nothing
    Set FSO = Nothing
    Set TempWB = Nothing
End Function

-- Esta função evocará o processo responsável por resgatar a assinatura e copiá-la no corpo do email
Function GetBoiler(ByVal SigFile As String) As String
    Dim FSO As Object
    Dim TS As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TS = FSO.GetFile(SigFile).OpenAsTextStream(1, -2)
    Let GetBoiler = TS.readall
    TS.Close

End Function

Deixe seus comentários, compartilhe este artigo!

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Brazil Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com