Views

...

Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

VBA - Convertendo o número do mês no nome por extenso - Convertendo o nome por extenso do mês no número

Hello folks!

Ao lidar com periodicidades móveis como MAT (Moving Annual Total), YTD (Year to Date), QTD (Quarter-To-Date), MTD (Month-To-Date), Year-ending, etc... Talvez necessitemos ajustar os nossos meses movendo-os dinamicamente.

How to convert month number to month name
Convert numbers to month names
Convert Month Name To Number
Convert Month Number to Month Name in Report based on query

A movimentação dos meses ajustada nas apresentações dos gráficos e das tabelas dos nossos Dashboards e Scorecards, invariavelmente requererão que os meses sejam manipulados internamente por somá-los ou subtraí-los, adequando as apresentações dos mesmos. Para que este feito fosse facilmente implementado precisaríamos transformar Novembro em 11 e 11 em Novembro, porexemplo. Como ?

Para o vosso regalo, seguem funções abaixo:

Function ABL_Convert_Number2MonthName (ByVal lngMonth As Long) As String
' Author: Date: Contact: URL:
' André Bernardes 28/06/2011 13:58 bernardess@gmail.com http://inanyplace.blogspot.com/
' Application: ®
' Converte o número do mês no respectivo nome (11 em Novembro).
' Listening: 20 - Flynn Lives - Daft Punk - TRON Legacy Soundtrack [Complete Edition](MP3@320Kbps)
On Error GoTo Err_GetMonthName

Dim dteTemp As Date

If lngMonthName < 1 And lngMonthName > 12 Then
Let ABL_Convert_Number2MonthName = vbNullString
Exit Function
End If

Let dteTemp = DateSerial(Year(Date), lngMonth, 1)
Let ABL_Convert_Number2MonthName = Format(dteTemp, "mmmm")

Exit Function

Err_GetMonthName:
Let ABL_Convert_Number2MonthName = vbNullString
End Function

Function ABL_Convert_MonthName2Number (monthName As String) As Integer
' Author: Date: Contact: URL:
' André Bernardes 28/06/2011 14:01 bernardess@gmail.com http://inanyplace.blogspot.com/
' Application: ®
' Converte o nome de um mês em número (Novembro em 11).
' Listening: 20 - Flynn Lives - Daft Punk - TRON Legacy Soundtrack [Complete Edition](MP3@320Kbps)
' try to convert month name to actual date type
Dim dtestr As String

Let dtestr = monthName & "/1/2011"

Dim dte As Date

On Error Resume Next

Let dte = CDate(dtestr)

If Err.Number <> 0 Then
Let ABL_Convert_MonthName2Number = -999
Exit Function
End If

On Error GoTo 0

Let ABL_Convert_MonthName2Number = Month(dte)
End Function

Vocabulário:

YTD = Year to Date

QTD = É um período iniciado no começo do trimestre em curso, terminando na data atual.

MAT = Moving Annual Total.

MTD = Month-To-Date


Tags: André Luiz Bernardes, MS, Microsoft, Office, VBA, Access, Excel, Word, Outlook, Sharepoint, convert, YTD, QTD, MAT, MTD, Month, Mês, converter,



André Luiz Bernardes
A&A® - Work smart, not hard.

EXCEL - Dica para otimizar velocidade de cálculos no Excel 2007

Dica para otimizar velocidade de cálculos no Excel 2007

Se utiliza o MS Excel 2007 em uma máquina com processador de dois (ou mais) núcleos você pode aumentar a velocidade de cálculo habilitando a opção "multithread": Clique no botão OFFICE/OPÇÕES DO EXCEL/AVANÇADO/PERMITIR CÁLCULOS MULTITHREAD

Com isso o MS Excel 2007 passa a fazer operações simultâneas de forma independente usando os núcleos separadamente. Isso significa uma sensível melhora de performance em planilhas parrudas, mas imperceptível no arroz-com-feijão do dia-a-dia.

Referência: Pasta1xls

VBA - Deletando Arquivos, Pastas e Diretórios

VBA - Deletando Arquivos, Pastas e Diretórios

Delete Files Via Vba
Delete Text File
Delete a folder and all subfolders and files
Delete files in a folder VBA
Deleting a file in VBA
How remove file
How to delete files using VBA
How to use VBA to delete files
I need to copy, rename and delete files in a folder
Macro to delete all files
Move and Delete files and folders
Remove Files

Já tentou apagar um arquivo externo a sua aplicação? Talvez uma planilha ou um arquivo texto?

Pense, como posso excluir um arquivo?

- Olhe para isto: "Poderia basicamente usar o comando Kill, mas um programador preocupado precisa permitir a possibilidade de existir um arquivo que está sendo usado somente como leitura, eis a função para você:

DeleteFile ("Bernardes_Dashboard_Results.txt")

 

Sub DeleteFile (ByVal FileToDelete As String)

 

If FileExists (FileToDelete) Then

 

SetAttr FileToDelete, vbNormal

 

Kill FileToDelete

 

End If

 

End Sub


Não se esqueça da função que checa a existência do arquivo:

Function FileExists(ByVal FileToTest As String) As Boolean
Let FileExists = (Dir(FileToTest) <> "")
End Function

 

Ahhh, você pode definir uma referência para a biblioteca Scripting.Runtime e depois usar o FileSystemObject, este tem dois métodos DeleteFile e FileExists.

Não vou esconder que temos outras opções:

Let nTest = Dir (filename)

 

If not nTest="" then

 

Kill (Filename)

 

end if


O código a seguir pode ser usado para testar a existência de um arquivo, e depois excluí-lo:

Dim aFile As String

 

Let nFile = "c:\Bernardes_Dashboard_Results.txt"

 

If Len (Dir$(nFile)) > 0 Then

 

Kill nFile

 

End If

Estava me segurando, mas preciso avisar-lhe quanto a não permitir que o código retorne uma mensagem de erro do tipo "Desculpe-me, mas não existe nenhum código para apagar", então coloque também algo como o mostrado abaixo:

On Error Resume Next
Kill "
c:\Bernardes_Dashboard_Results.txt
"

 

On Error Goto 0
Return Len(Dir$(aFile)) > 0


As opções não param. Aqui está um método simples de apagar uma pasta e todos os arquivos e subpastas. Ele usa o File System Object (objeto sistema de arquivos).
Para usá-lo, você terá que definir uma referência para o Microsoft Scripting Runtime geralmente encontrada em C:\WINDOWS\system32\scrrun.dll.

Sub DeleteAllFolders(FolderPath As String)
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
On Error Resume Next
fso.DeleteFolder (FolderPath)
Set fso = Nothing
End Sub

 

O método fso.DeleteFolder não pode retirar a barra à direita ("\") do path, por isso precisamos removê-la quando aparecer.

Function CorrectPath(FolderPath As String) As String

 

Let FolderPath = Trim(FolderPath)

 

If Right(FolderPath, 1) = "\" Then
Let CorrectPath = Left(FolderPath, Len(FolderPath) - 1)
Else
Let CorrectPath = FolderPath
End If

 

End Function

 

Compartilhe este artigo!  

VBA Excel - Outros modos para imprimir planilhas selecionadas ou não.

Olá pessoal!

Resolvamos mais esta questão quanto a impressão de planilhas, geralmente contendo Dashboards & Scorecards, ou Cockpits, que precisem ser impressas.
Este código imprime as planilhas selecionadas, veja o código do procedimento PrintSelectedsSheets mostrado abaixo.

Sub PrintSelectedSheets(Preview As Boolean)
Dim N As Long
Dim M As Long
Dim Arr() As String
With ActiveWindow.SelectedSheets
ReDim Arr(1 To .Count)
For N = 1 To .Count
Let Arr(N) = .Item(N).Name
Next N
End With
Sheets(Arr).PrintOut Preview:=True
End Sub

Como faço para imprimir apenas as pastas não selecionadas?

Sub PrintUnselectedSheets (Preview As Boolean)
Dim WS As Object
Dim N As Long
Dim Arr() As String
Dim K As Long
Dim B As Boolean
ReDim Arr(1 To ActiveWorkbook.Sheets.Count)
For Each WS In ActiveWorkbook.Sheets
Let B = True
With ActiveWindow.SelectedSheets
For N = 1 To .Count
Let B = True
If StrComp(WS.Name, .Item(N).Name, vbTextCompare) = 0 Then
Let B = False
Exit For
End If
Next N
If B = True Then
Let K = K + 1
Let Arr(K) = WS.Name
End If
End With
Next WS
If K > 0 Then
ReDim Preserve Arr(1 To K)
ActiveWorkbook.Sheets(Arr).PrintOut Preview:=Preview
End If
End Sub

Como posso fazer para imprimir todas as Sheets, excluindo as que passar como parâmetro?

PrintSheetsExclude false, "Sheet2", "Sheet4", "Sheet6"

This prints all sheets except Sheet2, Sheet4, and Sheet6. The code is shown below:

Sub PrintSheetsExclude (Preview As Boolean, ParamArray Excludes() As Variant)
Dim Arr() As String
Dim B As Boolean
Dim N As Long
Dim M As Long
Dim K As Long
ReDim Arr(1 To Sheets.Count)
For N = 1 To Sheets.Count
Let B = True
For M = LBound(Excludes) To UBound(Excludes)
If StrComp(Sheets(N).Name, Excludes(M), vbTextCompare) = 0 Then
Let B = False

Exit For
End If
Next M
If B = True Then
Let K = K + 1
Let Arr(K) = Sheets(N).Name
End If
Next N
If K > 0 Then
ReDim Preserve Arr(1 To K)
Sheets(Arr).PrintOut Preview:=Preview
End If
End Sub


Fonte: C Person

Tags: André Luiz Bernardes, Microsoft, MOS, MS, Office, Office 2007, Office 2010, automation, automação, print, various print, simultaneously print, multi print, selected


André Luiz Bernardes
A&A® - Work smart, not hard.

VBA Excel - Imprimindo múltiplas planilhas simultaneamente.

Olá pessoal!

Resolvamos uma questão constante no que diz respeito a impressão de diversas planilhas, geralmente contendo Dashboards, que precisam ser impressos juntos para nos permitir tanto rapidez como praticidade.

Quando imprimimos uma sheet no MS Excel, esta é impressa num trabalho de impressão próprio, mas a impressão de várias sheets criam vários trabalhos de impressão.

Neste artigo verá descrito um código que pode ser usado para imprimir várias planilhas como um único trabalho de impressão. O primeiro parâmetro para todas as funções é chamado de visualização e indica se as folhas devem ser exibidas na janela de pré-visualização (Preview = True) ou enviadas diretamente para a impressora ativa (Preview = False).
Esta Procedure tem como parâmetros os nomes das planilhas a serem impressas:

PrintSheets False, "Sheet1", "Sheet3", "Sheet5"
Este código imprime as planilhas: Sheet1, Sheet3, e Sheet5, vejoa o código do procedimento PrintSheets mostrado abaixo.

Sub PrintSheets (Preview As Boolean, ParamArray SheetNames() As Variant

' PrintSheets
' Todas as sheets que serão impressas são passadas como parametro.
' As sheets que não existirem serão ignoradas.

Dim Arr() As String
Dim N As Long
Dim K As Long
Dim B As Variant
Dim WS As Object

If UBound(SheetNames) >= LBound(SheetNames) Then
ReDim Arr(LBound(SheetNames) To UBound(SheetNames))

Let K = LBound(SheetNames)

For N = LBound(SheetNames) To UBound(SheetNames)
On Error Resume Next
Err.Clear

Set WS = Sheets(SheetNames(N))

If Err.Number = 0 Then
Let Arr(K) = SheetNames(N)
Let K = K + 1
End If

On Error GoTo 0
Next N

If K > 0 Then
ReDim Preserve Arr(LBound(Arr) To K - 1)
Sheets(Arr).PrintOut Preview:=Preview
End If

End If
End Sub




Fonte: C Person
Tags: André Luiz Bernardes, Microsoft, MOS, MS, Office, Office 2007, Office 2010, automation, automação, print, various print, simultaneously print, multi print,


André Luiz Bernardes
A&A® - Work smart, not hard.

eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine