Excel VBA – Retornando nome da Planilha (Return Name of Excel Workbooks or Return the Full File Path)

| Blog Office VBA | Blog Excel | Blog Access |

Disponibilizo abaixo duas funções (UDF's – User Definition Function) que retornarão o nome do arquivo (planilha utilizada). Estas poderão ser aproveitadas tanto em células, como na codificação VBA.

Function SingleFileName() As String
' Author: Date: Contact:
' André Bernardes 24/11/2008 16:37 bernardess@gmail.com
' Retorna apenas o nome do arquivo (Planilha).

Let SingleFileName = ThisWorkbook.Name

End Function

Function FullFileName() As String
' Author: Date: Contact:
' André Bernardes 26/11/2008 09:35 bernardess@gmail.com
' Retorna o Path, bem como o nome do arquivo (Planilha).

    Let FullFileName = ThisWorkbook.FullName

End Function


TAGS: File, Name, FullName, Path, Workbook, Sheet, Active

MS ACCESS – Compactando aplicação ao sair

Invariavelmente precisamos compactar nossas aplicações MS Access

Devido ao acumulo de dados excluídos, transportados, importados, etc...

Um modo de fazer isso sem que interfira demasiadamente na rotina dos

usuários, é por compactar a aplicação ao sair dela.

O código abaixo pode ser executado uma linha antes do comando fechar

da sua aplicação.

Function TomaticCompac()

' A&A - In Any Place. ' André Bernardes. ' Santos - SP. ' Posted in: 19.08.2008 - 10:26. Dim fObject, f, Tam, CompleteFile Dim strProjPath As String, strProjectName As String Let strProjPath = Application.CurrentProject.Path Let strProjName = Application.CurrentProject.Name Let CompleteFile = strProjPath & "\" & strProjName Set fObject = CreateObject("Scripting.FileSystemObject") Set f = fObject.GetFile(CompleteFile) ' Dividindo por mil para converter em MB. Let Tam = CLng(f.Size / 1000000) ' Indica o máximo de tamanho no qual o .MDB pode chegar If Tam > 20 Then ' Compacta a aplicação. Application.SetOption ("Auto Compact"), 1 Application.SetOption "Show Status Bar", True vStatusBar = SysCmd(acSysCmdSetStatus, "Esta aplicação está sendo compactada, por favor não interfira com o processo de Compactação!") Else ' Não compacta a aplicação. Application.SetOption ("Auto Compact"), 0 End If

End Function

ANDRÉ BERNARDES

MS Excel – Formulários Transparentes (Transparent (See through) userforms in Excel)

| Blog Office VBA | Blog Excel | Blog Access |

Este é um recurso útil para utilização em formulários utilizados como Splash
ou em outras áreas onde sua imaginação o tornar aplicável.
O que importa é que vc saiba como fazê-lo.
No módulo do formulário acrescente:
'==============================================================================================
' Microsoft® Office Excel by A&A - In Any Place.
' Copyright© A&A – In Any Place. All Rights Reserved.
'==============================================================================================
Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes _
Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&
Public hWnd As Long
Option Explicit
No evento de inicialização do seu formulário, faça uma chamada a função a seguir:
Function OpacityNow()
' Author: Date: Contact:
' André Bernardes 24/11/2008 10:09 bernardess@gmail.com
' Deixando o formulário transparente.
Dim bytOpacity As Byte
Let bytOpacity = 195 ' Nível de opacidade.
Let hWnd = FindWindow ("ThunderDFrame", Me.Caption)
Call SetWindowLong (Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes (Me.hWnd, 0, bytOpacity, LWA_ALPHA)
End Function
Boa diversão!

MS Excel - Como efetuar o refresh para todas as pivot tables da minha planilha com VBA?

Simples assim:

Function RefreshPT dim w as worksheet, p as pivottable

for each w in thisworkbook.worksheets for each p in w.pivottables p.refreshtable p.update next next

End Function

MS Excel – Diversas Funções Úteis.

| Blog Office VBA | Blog Excel | Blog Access |

No nosso dia-a-dia sempre acontece de precisarmos de uma funcionalidade útil e na maioria das vezes não gostaríamos de perder muito tempo para desenvolvê-las ou aprender como funcionam.

Para facilitar a sua vida, assim como fizeram comigo anteriormente (pois não tem nada que não tenhamos recebido antes de alguém), coloco abaixo alguns exemplos que espero sejam úteis para você.

Deletando arquivos facilmente, quando estes não estiverem em uso. Caracteres coringas (*) podem ser usados em substituição ao nome do arquivo (Mas cuidado!).

Sub DelFile() 

' Author: André Bernardes 

' Date: 13.10.2008 – 16:10 

' Contact: bernardess@gmail.com 

Dim MyFile As String 'Esta Linha de código é opcional 

On Error Resume Next 'Caso ocorram erros, estes não serão percebidos por usuários. 

Let MyFile = "c:\folder\filename.xls" 

Kill MyFile 

End Sub 

(Des)Protegendo a pasta (worksheet) corrente com uma senha de proteção.

Sub ProtegSheet() 

' Author: André Bernardes 

' Date: 13.10.2008 – 16:10 

' Contact: bernardess@gmail.com

Dim Psswrd ' Esta linha de código é opcional.

Let Psswrd = "bernardes"

ActiveSheet.Protect Psswrd, True, True, True 

End Sub

Sub UnProtegSheet() 

' Author: André Bernardes

 ' Date: 13.10.2008 – 16:10

 ' Contact: bernardess@gmail.com Let Psswrd = "bernardes"

ActiveSheet.Unprotect Psswrd 

End Sub

Protegendo todas as pastas (worksheets) de uma mesma planilha.

Sub ProtegAll() 

' Author: André Bernardes 

' Date: 11.10.2008 – 08:05 

' Contact: bernardess@gmail.com Dim PlansCount 

' Esta linha de código é opcional. Dim j 

' Esta linha de código é opcional.

Let PlansCount = Application.Sheets.Count 

' Retorna quantas pastas (worksheets) contém nesta planilha.

Sheets(1).Select 

' Aqui selecionamos a primeira pasta (worksheet).

For j = 1 To PlansCount ActiveSheet.Protect

If j = PlansCount Then End End If

ActiveSheet.Next.Select Next j 

End Sub

Prevenindo o usuário quanto a área da pasta (worksheets) que não pode ser alterada.

Este exemplo de código previnirá o usuário sobre selecionar células num range (área) específico na pasta (worksheet). Este procedimento pode ser escrito na própria pasta (worksheet) ou num módulo.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 

' Author: André Bernardes 

' Date: 10.10.2008 – 17:55 

' Contact: bernardess@gmail.com 

If Not Application.Intersect(Target, Range("A1:A100")) 

Is Nothing Then

Cells(ActiveCell.Row, 2).Select

MsgBox "Descupe, mas não pode selecionar células na faixa: A1:A100!"

End If

End Sub

Como obter o local de atividade da aplicação corrente:

MsgBox "Local de Atividade e nome da pasta: " & CurDir

Como mudar o local de atividade da aplicação:

ChDrive "D" ' changes to the F-station

Como mudar a pasta de atividade atual da aplicação:

ChDir "D:\Meus Documentos\Privado"

Como determinar se um arquivo existe na pasta:

If Dir("D:\Meus Documentos\MyPlan.xls") <> "" Then 

' Quando o arquivo não existe retorna "" (uma string vazia).

Se não especificar o local, o Excel usa o local atual. Se não especificar as pasta, o Excel usa a pasta onde a aplicação está. Como podemos criar uma nova pasta?

MkDir "NovaPastaParticular" ' Cria uma nova pasta no local que a planilha atual está.      

MkDir "D:\Meus Documentos\NovaPastaParticular" ' Cria uma nova pasta no local indicado.

Como apagar uma pasta (A pastas precisa estar vazia):

RmDir "NovaPastaParticular" ' Deleta a subpasta no local onde a planilha atual está.

RmDir "D:\Meus Documentos\NovaPastaParticular" ' Deleta a subpasta no local indicado.

Como copiar um arquivo (o mesmo precisa estar fechado):

FileCopy "Apontamentos.xls", "BAK-Apontamentos.xls" ' Copia-o na pasta local onde a planilha corrente está.

FileCopy "Apontamentos.xls", "X:\BAK-Apontamentos.xls" ' Copia o arquivo na pasta indicada.

Como mover um arquivo (o mesmo precisa estar fechado):

Let Old = "C:\Old\Balanço.xls" ' Localização original do arquivo.

Let New = "C:\New\Balanço.xls" ' Nova localização do arquivo.

Name Old As New ' Move o arquivo.

Tags: VBA, excel, worksheet, sheet, functions, UDF

MS Excel – Navegando entre as pastas na planilhas

Existem diversos modos para se navegar entre as pastas de uma planilha.

Estou postando uma das maneiras mais simples de se fazer isso.

Function SelectSheet()

' Inicia as variáveis.

Dim ThisShts As Variant

Dim mySht As Single

Dim MyList As Variant

' Obtém o número de pastas na planilha.

Let ThisShts = ActiveWorkbook.Sheets.Count

' Carrega o nome das pastas .

For i = 1 To ThisShts

Let MyList = MyList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr

Next i

' Mostra os nomes das pastas para serem escolhidas, através dos seus respectivos posicionamentos.

Let mySht = InputBox("Selecione o Nº da pasta e pressione OK:" & vbCr & vbCr & MyList)

Sheets(mySht).Select

End Function