Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

.: Vitrine

Carregando artigos...

Views

Mostrando postagens com marcador file. Mostrar todas as postagens
Mostrando postagens com marcador file. Mostrar todas as postagens

VBA Excel - Retorne o nome da Planilha



Estas duas funções UDFs (User Definition Function) retornam o nome do workbook (arquivo, a planilha utilizada).

Estas funções podem ser aproveitadas tanto diretamente nas células como internamente 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 


Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...


Tags: VBA, File, Name, FullName, Path, Workbook, Sheet, Active , nome, planilha, workbook,


Nenhum comentário:
Tags: , , , , , , , , ,

Excel Tips - Torne suas planilhas menores - SHRINK REDUCE EXCEL FILE SIZE


Já aconteceu de ter uma planilha de uns 5 ou 6 MB, na qual efetua algumas atualizações, talvez criando alguns gráficos, e algumas tabelas dinâmicas, de de repente vê essa planilha aumentar de tamanho de 3 a 100 vezes! 

Ficou surpreso? Sim, porque é possível, então não se preocupe demais, vou ajudá-lo.

Bem, em primeiro lugar precisamos entender a diferença entre Excel Default Last Cell e Actual Last Cell. Quando pressionamos Ctrl + End para encontrar a última célula (Actual Last Cell), nós chegamos a Excel Default Last Cell, que pode ser a Actual Last Cell ou podem ser células vazias que ficam muito além desta. Quanto mais distante da Excel Default Last Cell estiver a Actual Last Cell mais espaço desnecessário está sendo ocupado na planilha atual.

Qual a solução? Apague todas as linhas e colunas além do Actual Last Cell em cada planilha. Se houver demasiadas planilhas e grandes conjuntos de dados, poderá usar o código VBA a seguir:

Option Explicit

Sub SHRINK_XL()
    Dim WSheet As Worksheet
    Dim CSheet As String 'New Worksheet
    Dim OSheet As String 'Old WorkSheet
    Dim Col As Long
    Dim ECol As Long 'Last Column
    Dim lRow As Long
    Dim BRow As Long 'Last Row
    Dim Pic As Object
   
    For Each WSheet In Worksheets
        WSheet.Activate
         'Put the sheets in a variable to make it easy to go back and forth
        CSheet = WSheet.Name
         'Rename the sheet to its name with _Delete at the end
        OSheet = CSheet & "_Delete"
        WSheet.Name = OSheet
         'Add a new sheet and call it the original sheets name
        Sheets.Add
        ActiveSheet.Name = CSheet
        Sheets(OSheet).Activate
         'Find the bottom cell of data on each column and find the further row
        For Col = 1 To Columns.Count 'Find the actual last bottom row
            If Cells(Rows.Count, Col).End(xlUp).Row > BRow Then
                BRow = Cells(Rows.Count, Col).End(xlUp).Row
            End If
        Next
       
         'Find the end cell of data on each row that has data and find the furthest one
        For lRow = 1 To BRow 'Find the actual last right column
            If Cells(lRow, Columns.Count).End(xlToLeft).Column > ECol Then
                ECol = Cells(lRow, Columns.Count).End(xlToLeft).Column
            End If
        Next
       
         'Copy the REAL set of data
        Range(Cells(1, 1), Cells(BRow, ECol)).Copy
        Sheets(CSheet).Activate
         'Paste Every Thing
        Range("A1").PasteSpecial xlPasteAll
         'Paste Column Widths
        Range("A1").PasteSpecial xlPasteColumnWidths

        Sheets(OSheet).Activate
        For Each Pic In ActiveSheet.Pictures
            Pic.Copy
            Sheets(CSheet).Paste
            Sheets(CSheet).Pictures(Pic.Index).Top = Pic.Top
            Sheets(CSheet).Pictures(Pic.Index).Left = Pic.Left
        Next Pic
        Sheets(CSheet).Activate
       
         'Reset the variable for the next sheet
        BRow = 0
        ECol = 0
    Next WSheet
   
     ' Since, Excel will automatically replace the sheet references for you on your formulas,
     ' the below part puts them back.
     ' This is done with a simple replace, replacing _Delete with nothing
    For Each WSheet In Worksheets
        WSheet.Activate
        Cells.Replace "_Delete", ""
    Next WSheet
   
    'Roll through the sheets and delete the original fat sheets
    For Each WSheet In Worksheets
        If Not Len(Replace(WSheet.Name, "_Delete", "")) = Len(WSheet.Name) Then
            Application.DisplayAlerts = False
            WSheet.Delete
            Application.DisplayAlerts = True
        End If
    Next
End Sub

Tags: VBA, Excel, Sheet, woksheet, shrink, diminuir, reduce, compact, size, file, planilha, arquivo

Nenhum comentário:
Tags: , , , , , , , , , , ,

VBA Excel - Gravando a Planilha somente como Leitura - How to Make a File ReadOnly



Podemos gravar uma planilha no MS Excel apenas como leitura, se desejarmos.

O código abaixo faz referência ao FileSystemObject, e através dele podemos com a técnica late binding deixar até mesmo um conjunto de planilhas somente como leitura. É um bom código e podemos ampliá-lo por estendermos a sua aplicabilidade. Caso o faça, deixe mais abaixo a sua contribuição.


Function MakeReadOnly (ByVal sFile As String)
Dim strSaveFilename As String
Dim oFSO As Object

'Scripting.FileSystemObject
Dim oFile As Object

'Scripting.File

' Create Objects

' Uses Late Binding
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.GetFile(FilePath:=sFile)

' Set file to be read-only
Let oFile.Attributes = 1

' Releasing Objects
If Not oFSO Is Nothing Then Set oFSO = Nothing
If Not oFile Is Nothing Then Set oFile = Nothing End Function

É importante salientar que este código pode ser usado em outros Produtos da suíte MS Office.

Tags: Office, Exce, VBA, read only, file, 

Nenhum comentário:
Tags: , , , ,

VBA Excel - Copie Arquivos a partir das suas Datas - Copy all files between certain dates

Inline image 7

Imagine poder automatizar a cópia de arquivos de uma pasta de acordo com a respectiva data da sua gravação.

Esse processo seria muito significativo no que diz respeito a backup dentro de um processo batch.

Também seria proveitoso dentro de um processo onde arquivos texto precisassem ser movidos temporariamente, dentro de um intervalo mensal ou semanal, para uma pasta onde seriam processados e posteriormente deletados.

O exemplo abaixo nos propicia tal liberdade, e nos dá a liberdade de adequá-lo melhor, dentro das nossas necessidades.

Sempre é preciso ter cautela, pois no caso do código abaixo, há a possibilidade de sobrepormos arquivos.

Sub CopyFilesInDates()
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Fdate As Date
    Dim FileInFromFolder As Object 


    FromPath = "C:\Bernardes\Data"  


    ToPath = "C:\Bernardes\Process"     








    If Right(FromPath, 1) <> "\" Then 


        FromPath = FromPath & "\" 


    End If 








    If Right(ToPath, 1) <> "\" Then 


        ToPath = ToPath & "\" 


    End If 








    Set FSO = CreateObject("scripting.filesystemobject") 








    If FSO.FolderExists(FromPath) = False Then


        MsgBox FromPath & " não existe"


        Exit Sub


    End If 








    If FSO.FolderExists(ToPath) = False Then


        MsgBox ToPath & " doesn't exist"


        Exit Sub


    End If 








    For Each FileInFromFolder In FSO.getfolder(FromPath).Files


        Fdate = Int(FileInFromFolder.DateLastModified)


        'Copy files from 1-Oct-2006 to 1-Nov-2006


        If Fdate >= DateSerial(2006, 10, 1) And Fdate <= DateSerial(2006, 11, 1) Then


            FileInFromFolder.Copy ToPath


        End If


    Next FileInFromFolder 






    MsgBox "Você encontrará os seus arquivos daqui " & FromPath & ", aqui " & ToPath




End Sub





Tags: VBA, Excel, folder, file, pasta, arquivo, copia, planilha, Por data, 







































Nenhum comentário: 















Tags:
,
,
,
,
,
,
,
,


























VBA Excel - Copia todas as Planilhas - Copy all Excel files










Inline image 7








Não é tão difícil precisarmos rapidamente de um código que copie os arquivos de um local para o outro. Copiar na plena acepção da palavra, isto é, mantendo os arquivos originais em seus respectivos lugares.




Sub CopyFiles2Folder()


    Dim FSO As Object


    Dim FromPath As String


    Dim ToPath As String


    Dim FileExt As String 






    Let FromPath = "C:\Bernardes\Data01\Source" 


    Let ToPath = "C:\Bernardes\Data01\Target"   




    Let FileExt = "*.xl*"  


    




    If Right(FromPath, 1) <> "\" Then 


        FromPath = FromPath & "\" 


    End If








    Set FSO = CreateObject("scripting.filesystemobject")




    If FSO.FolderExists(FromPath) = False Then


        MsgBox FromPath & " doesn't exist"


        Exit Sub


    End If 








    If FSO.FolderExists(ToPath) = False Then


        MsgBox ToPath & " doesn't exist"


        Exit Sub


    End If 








    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath


    MsgBox "Pode encontrar os arquivos que estavam aqui " & FromPath & ", aqui " & ToPath




End Sub



Tags: VBA, Excel, file, pasta, arquivo, copiar, planilha







































Nenhum comentário: 















Tags:
,
,
,
,
,
,
















 
 










Assinar:
Postagens (Atom)





































































diHITT - Notícias