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
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
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:
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)
Resultado final:
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
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
Registo/Mapa Deslocações
Registo/Mapa de Despesas de Deslocações com relatório no final.
Se pretender por logótipo ou outra informação na base de dados e/ou relatório, contacte-nos: clico@clico.pt
Se não tiver o Access instalado na máquina, corra o Microsoft Access Runtime do site da Microsoft.
UPDATE 29-06-2017 : Limpa a base de dados para não ter dados de exemplo, criando uma limpa para o utilizador.
Enviar Emails com ficheiro comprimido como anexo quando estiver na Data Actual (VBA)
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.
VBA Code/Macro:
Sub SendEmail()
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
Como Excluir Linhas Duplicadas no Excel com VBA (Passo a Passo)
Public Sub DeleteDuplicatedLines()
‘***************************************
‘*** Code to Remove Duplicated Lines ***
‘***** E-Mail: clico.tech@gmail.com ******
‘***************************************
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range
On Error GoTo Erro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r
Erro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Criar ListBox Excel VBA
Creating a Listbox using Excel VBA Editor, try it 🙂
