About Me

A minha fotografia
JRod - PORTUGAL
Microsoft [MVP] - Excel (10º ano consecutivo)
Ver o meu perfil completo
Com tecnologia do Blogger.

Seguidores

Estatisticas

Free Blog Counter

eXTReMe Tracker
Ocorreu um erro neste dispositivo
2007-01-31

Se pretendermos construir um ToolBar personalizado (a que chamaremos "MyToolBar"), desactivando outros ToolBars existentes, deixando apenas activo o ToolBar denominado "WorkSheet Menu Bar" e o MyToolBar e ainda que este seja apagado quando saímos do workbook, reactivando todos os outros ToolBars e, por fim, que, quando de novo abrirmos o workbook, voltemos a ter o MyToolBar  disponível, podemos utilizar as seguintes peças de código, para o exemplo que se apresenta:

 

 

 

Código num módulo:

Sub MakeToolBar()
 
    On Error Resume Next
    Application.CommandBars("MyToolBar").Delete
    On Error GoTo 0


    With Application.CommandBars.Add(Name:="MyToolBar", _
                                     Position:=msoBarTop, MenuBar:=False)

        .Protection = msoBarNoCustomize


        With .Controls.Add(Type:=msoControlButton)
            .Style = msoButtonCaption
            .DescriptionText = "Imprime, Grava e Sai"
            .TooltipText = "Imprime, Grava e Sai"
            .Caption = "Imprime/Grava/Sai"
            .OnAction = "Imprime_Grava" 
        End With

        With .Controls.Add(Type:=msoControlButton)
            .Style = msoButtonCaption
            .DescriptionText = "Limpar os Dados Anteriores"
            .TooltipText = "Limpa os Dados Anteriores"
            .Caption = "Limpa Dados"
            .OnAction = "Limpa"
        End With

        With .Controls.Add(Type:=msoControlButton)
            .Style = msoButtonCaption
            .DescriptionText = "Gravar o Novo Mês"
            .TooltipText = "Grava o Novo Mês"
            .Caption = "Novo Mês"
            .OnAction = "GravaSai"
        End With

        With .Controls.Add(Type:=msoControlButton)
            .Style = msoButtonCaption
            .DescriptionText = "Inserção do valor que vem do fecho do mês anterior"
            .TooltipText = "Digitar o Valor do Mês Anterior"
            .Caption = "Valor Mês Anterior"
            .OnAction = "Valor_Anterior"
        End With

        Application.CommandBars("MyToolBar").Visible = True

    End With
End Sub

Sub DeleteToolBar()
    Dim bar As CommandBar
    On Error Resume Next
    Application.CommandBars("MyToolBar").Delete
    On Error GoTo 0
End Sub

 

Código no Workbook:

Private Sub Workbook_Activate()


    On Error Resume Next


    With Application.CommandBars("Worksheet Menu Bar")
        .Enabled = True
        .Visible = True
    End With

    With Application.CommandBars("Formatting")
        .Enabled = False
        .Visible = False
    End With


    With Application.CommandBars("Standard")
        .Enabled = False
        .Visible = False
    End With


    With Application.CommandBars("TranslateIT")
        .Enabled = False
        .Visible = False
    End With

    MakeToolBar

    On Error GoTo 0
End Sub


Private Sub Workbook_Deactivate()


    On Error Resume Next


    With Application.CommandBars("Worksheet Menu Bar")
        .Enabled = True
        .Visible = True
    End With

    With Application.CommandBars("Formatting")
        .Enabled = True
        .Visible = True
    End With


    With Application.CommandBars("Standard")
        .Enabled = True
        .Visible = True
    End With


    With Application.CommandBars("TranslateIT")
        .Enabled = True
        .Visible = True
    End With

    DeleteToolBar

    On Error GoTo 0
End Sub

2007-01-12

Se pretendermos  usar o Excel para listar o conteúdo de um directório ou de uma pasta, mostrando cada nome de ficheiro numa célula de uma coluna (no exemplo, coluna A) e mostrando, igualmente a data/hora na célula correspondente da coluna seguinte e ainda fazer com que as colunas fiquem com a sua largura ajustada ao tamanho do  nome do ficheiro mais extenso, como no exemplo:

   

 

podemos utilizar o seguinte código:

 

' A partir do código apresentado num newsgroup por Tom Ogilvy

Sub ListDirectory()
Dim Msg As String
Dim rw As Long
Dim i As Long
Dim sDir As String
Msg = InputBox("Escolha o Path:")
sDir = Msg


If Len(Trim(Msg)) = 0 Then
  MsgBox "Não seleccionou nada . . ."
  Exit Sub
End If


With Application.FileSearch
    .NewSearch
    .LookIn = sDir
    .SearchSubFolders = True
    .FileName = "*.*"
    .FileType = msoFileTypeAllFiles
    rw = 2
    If .Execute() > 0 Then
    Sheets("Sheet1").Range("A:A").Clear

        For i = 1 To .FoundFiles.Count
            Sheets("Sheet1").Cells(rw, "A").Value = Dir(.FoundFiles(i))
            Sheets("Sheet1").Cells(rw, "B").Value = FileDateTime(.FoundFiles(i))
            rw = rw + 1
        Next i
    Else
        MsgBox "Não foram encontrados ficheiros"
    End If
End With
Sheets("Sheet1").Cells(1, 1).Value = "Nome do Ficheiro"
Sheets("Sheet1").Cells(1, 2).Value = "Data/Hora"
Columns("A:B").AutoFit
End Sub

2007-01-08

Se pretendermos transformar Nome e Apelido em Apelido, Nome como no exemplo:

podemos utilizar a seguinte fórmula (créditos para Bob Phillips):

=MID(A1;FIND(" "A1)+1;255)&", "&LEFT(A1;FIND(" "A1))

 

Mas se pretendermos o contrário, ou seja, transformar Apelido, Nome em Nome e Apelido como no exemplo:

então, poderemos utilizar, a partir da fórmula anterior, a seguinte fórmula alterada:

=MID(A2;FIND(" ";A2)+1;255)&" "&LEFT(A2;FIND(", ";A2)-1)