VBA Excel - Inserindo uma logomarca animada - Animating Your Company’s Logo in Excel

| Blog Office VBA | Blog Excel | Blog Access |

+ de 100.000 VISITAS

Acesse: http://goo.gl/0v6AO   

As Logomarcas são uma maneira fácil de adicionar um senso de profissionalismo ao trabalho que estamos entregando. 

Telas iniciais e logotipos são parte de cada produto de software que adquirimos e também devem ser parte integrante de cada aplicação que você fornecer ao seu Cliente. 

Agora, se o seu logo for animando...Isso será ainda mais divertido! 

Além de divertir os usuários, definirá o seu trabalho para além da média com um desenvolvedor de aplicações para o Excel.

Eu procuro usá-los quando a primeira pasta de trabalho é aberta (Passo-a-passo até para os iniciantes hein!):

- Abra uma pasta de trabalho em branco

- Renomeie a primeira guia "Dados"

- Esta será a planilha exibida quando o nosso workbook for aberto

- Agora, obtenha uma cópia animada do logotipo da sua empresa

  No site da sua empresa provavelmente tem um com o tamanho certo

- Cole-o na planilha de dados

- Precisamos de nomeá-lo "Logo"

- Selecione-o, e em seguida, use Alt-F11 para chegar ao Editor do Visual Basic. 

- Use Ctrl-R para abrir o Project Explorer

- Dê um duplo clique em "ThisWorkbook" (ou EstaPasta_de_trabalho) 

Isso traz à tona a janela de código da pasta de trabalho. 

- Essa rotina deve ser executada logo que o workbook for aberto, por isso vamos codificá-la em Workbook_Open

- Esta rotina ativavá a aba que renomeamos para "Data", e em seguida passa à nossa "Logo" para duas rotinas. 

- A primeira faz "crescer" a nossa logomarca. 

- A segunda faz girá-la uma vez.

Private Sub Workbook_Open()

    Worksheets("Dados").Activate

    ActiveSheet.Shapes("Logo").LockAspectRatio = False

    GrowShape ActiveSheet.Shapes("Logo"), 10

    SpinShape ActiveSheet.Shapes("Logo"), 10

           

End Sub

A rotina GrowShape expandirá qualquer shape à vista. Primeiro desligará atualização de tela. Isso nos permitirá fazer alterações nos bastidores e exibir os resultados quando estivermos prontos. 

Em seguida, a rotina GrowShape se lembrará das dimensões do shape. Em seguida, a rotina muda o tamanho do shape, exibe-o, congela a tela e faz loops até terminar. Antes de finalizar, a rotina GrowShape garante que o shape está exatamente como o encontramos.

A rotina SpinShape é quase idêntica. Congela a tela, lembra as dimensões originais do shape, em seguida, altera o tamanho do shape num circuito que simula-o girando em torno do seu eixo Y. Quando termina, a rotina SpinShape restaura o shape ao seu tamanho original.

Isso é tudo o que precisamos para animarmos um logotipo!

Function GrowShape (ByRef Shape As Shape, Step As Integer) As Boolean

'   Description:Expands a shape into view

'   Parameters: Shape       The shape to animate

'               Step        Larger #s animate faster

'   Example:    GrowShape ActiveSheet.Shapes("Logo"), 10

'   Note:       For best results, shape should be hidden before calling

'               this routine

'     Date   Init Modification

'   01/10/11 CWH  Initial Programming

    Dim lCenterX As Long    'Shape's center X coordinate

    Dim lCenterY As Long    'Shape's center Y coordiante

    Dim lWidth   As Long    'Shape's width

    Dim lHeight  As Long    'Shape's height

    Dim l        As Long    'Generic Counter for the loop

   

    Application.ScreenUpdating = False

   

    With Shape

       'Remember shape's original dimensions

        lCenterX = .Width / 2 + .Left

        lCenterY = .Height / 2 + .Top

        lWidth = .Width

        lHeight = .Height

       'Animation Loop

        For l = 0 To lWidth Step Step

            .Width = l

            .Height = l * lHeight / lWidth

            .Left = lCenterX - .Width / 2

            .Top = lCenterY - .Height / 2

            Shape.Visible = True

            Application.ScreenUpdating = True

            Application.ScreenUpdating = False

        Next l

       'Restore shape's original dimensions

        .Width = lWidth

        .Height = lHeight

        .Left = lCenterX - .Width / 2

        .Top = lCenterY - .Height / 2

    End With

   

    Application.ScreenUpdating = True

End Function

Function SpinShape (ByRef Shape As Shape, Step As Integer) As Boolean

'   Description:Expands a shape into view

'   Parameters: Shape       The shape to animate

'               Step        Larger #s animate faster

'                           Steps should divide 90 evenly

'   Example:    SpinShape ActiveSheet.Shapes("Logo"), 10

'     Date   Init Modification

'   01/10/11 CWH  Initial Programming

   

    Const Pi = 3.14159265358979

    Dim sng01 As Single     '1 Degree in Radians

        sng01 = Pi / 180

       

    Dim lCenterX As Long    'Shape's center X coordinate

    Dim lCenterY As Long    'Shape's center Y coordiante

    Dim lWidth   As Long    'Shape's width

    Dim lHeight  As Long    'Shape's height

    Dim l        As Long    'Generic Counter for the loop

   

    Application.ScreenUpdating = False

   

    With Shape

        .LockAspectRatio = False

       'Remember shape's original dimensions

        lCenterX = .Width / 2 + .Left

        lCenterY = .Height / 2 + .Top

        lWidth = .Width

        lHeight = .Height

       'Animation Loop

        For l = 0 To 360 Step Step

            .Width = lWidth * Abs(Cos(l * sng01))

            .Left = lCenterX - .Width / 2

            If l = 90 Or l = 270 Then .Flip msoFlipHorizontal

            Shape.Visible = True

            Application.ScreenUpdating = True

            Application.ScreenUpdating = False

        Next l

       'Restore shape's original dimensions

        .Width = lWidth

        .Height = lHeight

        .Left = lCenterX - .Width / 2

        .Top = lCenterY - .Height / 2

    End With

   

    Application.ScreenUpdating = True

End Function

Tags: VBA, Excel, development, Microsoft Excel, tutorial, logo, logomarca, animar, animated,

VBA Access - Animando o título do formulário e do ícone da Barra de Tarefas - Animate String

Termo de Responsabilidade 

Neste exemplo estou aplicando o código no MS Access, mas com poucas adaptações também pode ser aplicado aos demais produtos da suíte MS Office.

É um efeito que deve ser usado de forma comedida, caso contrário chama muito a atenção. Talvez possa utilizá-lo:

- Quando termina um processamento e você deseja chamar a atenção para o formulário;

- Quando determinado valor é alcançado, deseja que o formulário já indique chamando a atenção;

- etc...

Para aplicá-lo a um formulário insira o código dessa maneira (Defina 300 ms para testar):

Private Sub Form_Timer()

    ' Author:                     Date:               Contact:                 URL:

    ' André Bernardes             20/05/2010 11:15    bernardess@gmail.com     André Luiz Bernardes - CURRICULUM VITAE

    ' Atualiza o relógio para ver que funciona.    

    [Form_frm_Avisos].Caption = AniText("  Software Bernardes® - Copyright© Bernardes S.A.", 3)

    

    [Form_frm_Avisos].Repaint

End Sub

Agora, você pode aplicar este efeito também no título da aplicação, ou seja, alterar o Caption do próprio MS Access. Isso envolve o título da janela aberta e também o ícone na barra de trabalho. Como?

Private Sub Form_Timer()

    ' Author:                     Date:               Contact:                 URL:

    ' André Bernardes             20/05/2010 11:15    bernardess@gmail.com     https://sites.google.com/site/bernardescvcurriculumvitae/

    ' Atualiza o relógio para ver que funciona.

    

    Dim dbs As Database

    Set dbs = CurrentDb

    'Me.lblTime.Caption = ""

    [Form_frm_Avisos].lblTime.Caption = Right(Now(), 9)

    [Form_frm_Avisos].Caption = AniText("  Software Bernardes® - Copyright© Bernardes S.A.", 3)

    

    dbs.Properties!AppTitle = AniText("  Software Bernardes® - Copyright© Bernardes S.A.", 1)

    Application.RefreshTitleBar

    [Form_frm_Avisos].Repaint

End Sub

Sim, mas para que esse processo funcione, precisamos da função AniText, segue:

Global Cl As Integer

Global at As Integer

Public Function AniText(str As String, eff As Integer) As String

    ' Author:                     Date:               Contact:                 URL:

    ' André Bernardes             13/03/2010 12:22    bernardess@gmail.com     https://sites.google.com/site/bernardescvcurriculumvitae/

    ' Retorna a string animada.

    

    Dim lop

    Let Cl = Len(str) + 1

    Let at = at + 1

    If at >= Cl Then

        Let at = 1

    End If

    Select Case eff

    Case 0          'Move to Right

        Let AniText = Mid(str, at) + Left(str, at)

    Case 1          'Move to Left

        Let AniText = Mid(str, (Cl - at)) + Left(str, (Cl - at))

    Case 2          'Move to Centre

        Let AniText = Mid(str, (Cl - at)) + Left(str, (Cl - at)) + Mid(str, at) + Left(str, at)

    Case 3          'Move to BothSide

        Let AniText = Mid(str, at) + Left(str, at) + Mid(str, (Cl - at)) + Left(str, (Cl - at))

    End Select

End Function

References:

Tags: VBA, Office, Access, Tips, animar, animate, form, formulário, caption, move, mover, string, texto,