• +351 91 33 888 29
    • clico@clico.pt

    Category Archive Funções/ Macro / VBA

    factorials

    Excel VBA – Calculate Factorial

    Excel VBA Code - Calculate Factorial

    Well-structured VBA code for calculating the factorial of a number.

    Open Microsoft Excel, create a new blank book, after go to TAB Programmer or click Alt+F11 and access to VBA Project.

    Copy/paste code and try…

    Sub CalculateFactorial()
    Dim num As Integer
    Dim result As Double

    ‘ Input
    num = InputBox(“Enter a number:”)

    ‘ Calculate factorial
    result = Factorial(num)

    ‘ Output
    MsgBox “The factorial of ” & num & ” is ” & result
    End Sub

    Function Factorial(n As Integer) As Double
    If n = 0 Then
    Factorial = 1
    Else
    Factorial = n * Factorial(n – 1)
    End If
    End Function

    VBA_Factorial_4

    O impacto da Impressão em Série Word (VBA)

    O código a seguir, guarda em Word e em PDF documento a documentos de um ficheiro de impressão em série. 

    Copie o código abaixo e cole em VBA no Microsoft Word, para abrir o Editor Visual Basic Applications:  (Alt+F11) ou lado direito do rato no separador(friso), personalizar separador e depois seleccionar Programador.

    Sub Guardar_Imprimir_Individualmente()

    ‘Separa um registo de um ficheiro de impressão em série de cada vez para a pasta escolhida

    Application.ScreenUpdating = False

    Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long

    Set MainDoc = ActiveDocument

    With MainDoc

      StrFolder = .Path & “”

      For i = 1 To .MailMerge.DataSource.RecordCount

        With .MailMerge

          .Destination = wdSendToNewDocument

          .SuppressBlankLines = True

          With .DataSource

            .FirstRecord = i

            .LastRecord = i

            .ActiveRecord = i

            StrName = .DataFields(“Partners”)

          End With

          .Execute Pause:=False

        End With

        With ActiveDocument

          .SaveAs2 FileName:=StrPath & StrName & “.docx”, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

          ‘ and/or:

          .SaveAs2 FileName:=StrPath & StrName & “.pdf”, FileFormat:=wdFormatPDF, AddToRecentFiles:=False

          .Close SaveChanges:=False

        End With

      Next i

    End With

    Application.ScreenUpdating = True

    End Sub

    Mapa Assiduidade com Controlo de Horas

    Mapa de Assiduidade com controlo de Horas.

    Calculo Semanal e Mensal de horas trabalhadas por cada colaborador.

    Para mais informações: clico@clico.pt

    Excel Geocoding

    Geocodificação com Microsoft Excel e Bing Maps

    Numa pesquisa sobre geocodificação usando Excel e Google Maps, encontrei um modelo de excel com todo o código já feito, bastante interessante. Para que funcione basta somente ativar as Macros no Microsoft Excel e criar uma chave API do Bing Maps.

    Faça download em:

    Excel Geocoding tool

    Excel Geocoding

    Identificar linha e coluna

    VBA- Identificar ultima linha e coluna da folha de calculo

    Uma rotina que sempre precisamos recorrer nos nossos códigos e macros é aquela onde podemos recuperar a última linha e coluna que estão escritas na nossa folha de cálculo.Em diversas situações torna-se necessário utilizar esta informação, como por exemplo, quando precisamos percorrer todas as linhas da nossa folha de cálculo que possuam dados, seja uma lista de nomes, de produtos, de telefones ou qualquer outro tipo de lista. 

    Neste artigo vou explicar como obter esta informação em qualquer folha de cálculo, automaticamente. 

    O código aqui apresentado, serve para utilizar em qualquer folha de cálculo.

    Já utilizei este código várias vezes, inclusive em exemplos já disponibilizados aqui no site. Um exemplo deste uso pode ser encontrado no artigo onde ensino a macro para enviar emails para sua lista ou neste outro no qual mostro como exibir uma barra de progresso para controlar o andamento do processamento da macro.

    Este código é um exemplo e deverá ser contextualizado a cada projecto.

    Para aceder ao editor de Macros VBA, carregue nas seguintes teclas: (ALT+F11),  de seguida insira um Módulo e digite/copie o código abaixo.

    Sub UltimaLinhaColuna()

    Dim iUltimaLinha As Long
    Dim iUltimaColuna As Long
    Dim sh As Worksheet
    Dim rng As Range

    Set sh = ActiveSheet ‘Referência a folha que pretendemos encontrar a ultima linha e coluna

    Set rng = sh.Range(“A1”).SpecialCells(xlCellTypeLastCell)

    iUltimaLinha = rng.Row ‘Encontra a última linha
    iUltimaColuna = rng.Column ‘Encontra a última coluna

    MsgBox “A última linha com dados é: ” & iUltimaLinha & vbCrLf & “A última coluna com dados é: ” & iUltimaColuna, vbInformation

    End Sub

    Voltando a folha de cálculo, para ver a lista de Macros criadas, carregue nas teclas:(Alt+F8) e de seguida execute  a macro criada (neste caso UltimaLinhaColuna)

    Identificar ultima linha e coluna VBA

    Resultado final:

    Identificar linha e coluna

    Ordenar Folhas Excel de forma Automatizada (Macro)

    Pretende-se com esta macro Ordenar as Folhas de um livro de Excel de forma ascendente.

    Video que mostra como fazer:

     

    Código:

    Option Explicit
    Sub OrdenarFolhas()
    ‘Esta rotina coloca as folhas de Excel por ordem ascendente

    Dim NomeFolhas() As String
    Dim ContarFolhas As Long
    Dim i As Long
    Dim AntigaFolhaActiva As Object

    ‘Se não houver folha activa
    If ActiveWorkbook Is Nothing Then Exit Sub

    ‘Verifica se a estrutura do livro esta protegida, se sim, não consegue ordenar e
    ‘devolve uma mensagem ao utilizador
    If ActiveWorkbook.ProtectStructure Then
    MsgBox ActiveWorkbook.Name & ” está protegida, “, vbCritical, “Não é possivel ordenar as folas. “
    Exit Sub

    End If

    ‘Verifica se o utilizador quer mesmo fazer a ordenação
    If MsgBox(“Pretende ordenar as folhas deste livro de Excel?”, vbQuestion + vbOKCancel) <> vbOK Then Exit Sub

    ‘Desactiva o CTRL+BREAK (opção cancelar)
    Application.EnableCancelKey = xlDisabled

    ‘Vai buscar o numero de folhas existentes
    ContarFolhas = ActiveWorkbook.Sheets.Count

    ‘Redimensiona a Array
    ReDim NomeFolhas(1 To ContarFolhas)

    ‘Armazena uma referência da folha activa
    Set AntigaFolhaActiva = ActiveSheet

    ‘Preenche a array com os nomes das folhas
    For i = 1 To ContarFolhas
    NomeFolhas(i) = ActiveWorkbook.Sheets(i).Name
    Next i

    ‘Coloca a array na ordem ascendente
    Call BubbleSort(NomeFolhas)

    ‘Desactiva a actualização de ecran
    Application.ScreenUpdating = False

    ‘Move/Ordenas as folhas
    For i = 1 To ContarFolhas
    ActiveWorkbook.Sheets(NomeFolhas(i)).Move _
    before:=ActiveWorkbook.Sheets(i)
    Next i

    ‘Reactiva a folha original
    AntigaFolhaActiva.Activate

    End Sub

    Sub BubbleSort(List() As String)
    ‘Função criada para ordenar as folhas e que é chamada em cima

    Dim primeiro, Ultimo As Long
    Dim i, j As Long
    Dim Temp As String

    primeiro = LBound(List)
    Ultimo = UBound(List)

    For i = primeiro To Ultimo – 1
    For j = i + 1 To Ultimo
    If List(i) > List(j) Then
    Temp = List(j)
    List(j) = List(i)
    List(i) = Temp
    End If
    Next j
    Next i
    End Sub

    Proteger Folhas Excel

    Proteger folhas de Excel

    Se pretender proteger todas as suas folhas de Excel de uma só vez….aqui fica o código! 😉

    Depois de executar basta inserir a password!

    Sub ProtegerFolhas()
    Dim ws As Worksheet
    Dim ps As String
    ps = InputBox(“Digite a password!”, vbOKCancel)
    For Each ws In ActiveWorkbook.Worksheets
    ws.Protect Password:=ps
    Next ws
    End Sub

    Excel Formulas e Funções – Manual Básico

    As fórmulas de cálculo são necessárias à realização de operações aritméticas e actualização dos dados após
    modificação. Estes cálculos podem ser simples operações aritméticas ou complexas equações matemáticas.

    Descarregue aqui…

    Enviar email quando Data de Envio for igual a Data Actual

    Pretende-se com este código que quando a Data de Envio for igual a data em que nos encontramos é enviado um email ao destinatário.

    O código pesquisa todos os registos e envia para cada email onde a condição da data for a data actual.

    Código:
    Public ws As Worksheet
    Public iCount As Integer    ‘ String used to count exist records
    Public lastrow As Long      ‘ String used to detect last used row to add next record
    Private Sub cmdAdd_Click()
    Dim TClientID As Integer
        
         iCount = Application.WorksheetFunction.CountIf(Range(“A1:A10000”), “C*”)
       
        With ws.UsedRange
            lastrow = .Rows(.Rows.Count).Row
        End With
        
        TClientID = ws.Range(“A” & lastrow).Value
        
        ‘Select new row to add record
        ws.Range(“A” & lastrow + 1).Select
        
        Me.Repaint
        Populate_Fields
        ‘Add next number to record
        Me.txtClientID = TClientID + 1
        
    End Sub
    Private Sub cmdClose_Click()
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.Quit
    End Sub
    Private Sub cmdSave_Click()
    ActiveCell.Offset(0, 0).Value = Me.txtClientID.Text
    ActiveCell.Offset(0, 1).Value = Me.txtName.Text
    ActiveCell.Offset(0, 2).Value = Me.txtOrderedDate.Text
    ActiveCell.Offset(0, 3).Value = Me.txtSendDate.Text
    ActiveCell.Offset(0, 4).Value = Me.txtProduct.Text
    ActiveCell.Offset(0, 6).Value = Me.txtEmail.Text
    ActiveCell.Offset(0, 7).Value = Me.txtcontact.Text
    MsgBox “Document Saved!”, vbOKOnly
    End Sub
    Private Sub cmdSendEmail_Click()
        Dim ws As Worksheet
        Dim oApp As Object, MailApp As Object, SendMail As Object
        Dim strbody As String
        Dim deldate As Variant
        Dim email As Variant
        Dim i As Integer
        
        Set ws = Worksheets(“sheet1”)
        ws.Select
          
        ‘Set numrows = number of rows of data.
         NumRows = Range(“A2”, Range(“A2”).End(xlDown)).Rows.Count
         
        ‘ Select cell A2
        Range(“A2”).Select
        
        ‘Get Delivery date
        lin = 2
        col = 4
        deldate = ws.Cells(lin, col).Value
        
        ‘Get email
        lin = 2
        col = 7
        email = ws.Cells(lin, col).Value
        ‘ -1 because sheet have header
        For i = 1 To NumRows – 1
        
                If deldate = Date Then
        
                    ‘Create Email
                    Set MailApp = CreateObject(“Outlook.Application”)
                    Set SendMail = MailApp.CreateItem(0)
                    ‘Conteudo corpo da mensagem
                    strbody = “Your require thing has been delivered … ” & vbNewLine & vbNewLine & _
                              “Thanks” & vbNewLine & _
                              “…”
            
                    On Error Resume Next
                    With SendMail
                        .To = email   ‘<- Email to send
                        .CC = “”
                        .BCC = “”
                        .Subject = “Your require thing has been delivered …”
                        .Body = strbody ‘<- Body message
                        .Send ‘ .Display <- Before send email to client show
                                 ‘ .send <- Send Email direct
                    End With
                    Else: Exit Sub
                End If
                ActiveCell.Offset(lin + i, 0).Select
                deldate = ws.Cells(lin + i, 4).Value
                email = ws.Cells(lin + i, 7).Value
        Next
             
        
    End Sub
    Private Sub UserForm_Initialize()
    Set ws = Worksheets(“sheet1”)
    Range(“A2”).Select
    Populate_Fields
    End Sub
    Private Sub Populate_Fields()
    Set ws = Worksheets(“sheet1”)
    ws.Select
    ActiveCell.Offset(0, 0).Select
    Me.txtClientID.Text = ActiveCell.Offset(0, 0).Value
    Me.txtOrderedDate = ActiveCell.Offset(0, 2).Value
    Me.txtSendDate = ActiveCell.Offset(0, 3).Value
    Me.txtName = ActiveCell.Offset(0, 1).Value
    Me.txtProduct = ActiveCell.Offset(0, 4).Value
    Me.txtEmail = ActiveCell.Offset(0, 6).Value
    Me.txtcontact = ActiveCell.Offset(0, 7).Value
    End Sub

    Codigo VBA – Verifica se Outlook esta aberto e devolve respectiva mensagem

    Codigo VBA – Verifica se Outlook esta aberto e devolve respectiva mensagem experimente .

    VBA Code – See if Outlook is running and give a message, try it


    Advertisements
    Show Buttons
    Hide Buttons