Excel Tips - Calendário Compacto para 2014 - THE COMPACT CALENDAR 2014

Consultancy in Excel, Access, VBA, Dashboards, Scorecards & PowerPoint Projects

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

Continua o nosso desafio quanto a manter o controle sobre os diversos projetos e atividades nas quais estamos envolvidos! 

Acompanharmos as diversas fases em vários cronogramas exige disciplina e assertividade. Ter uma boa ferramenta de apoio, pode ser a diferença entre atingir os nossos objetivos ou despercebermos que deveríamos ter feito isso.

O que se segue é uma versão traduzida do Calendário Compacto para 2013, desenvolvido por David Seah.

Este calendário tem uma apresentação compacta, dividida em semanas, com linhas numeradas numa planilha Excel. Usá-lo nos ajudará a avaliarmos melhor a duração dos eventos previstos nas semanas do ano.

DOWNLOAD - BAIXE AQUI

Esta versão do calendário é ideal para os projetos onde se planeja controlar as várias fases da implementação. Sua impressão está posicionada na margem esquerda de uma folha A4, proporcionando muito espaço para comentários e anotações.

Este Calendário Compacto é um Calendário de Planejamento muito versátil, fácil de personalizar e imprimir a partir do Microsoft Excel. 

Por padrão, o calendário inclui os feriados americanos destacados em vermelho, mas podemos inserir outros eventos.

Solicite uma versão 

Deixe um comentário junto com o seu endereço de e-mail neste POST. (Acesse ao link do post, pois este artigo está sendo replicado em vários blogs)

O Calendário Compacto é simples de imprimir. Encaixa-se em uma única página, as semanas são apresentadas como uma pilha de tempo disponível, torna-se fácil bloquear os dias, fazendo anotações sobre reuniões, feriados e fins de semana.

Modificando o Calendário Compacto

Precisará ter no mínimo o Microsoft Excel 2007 ou versão posterior para modificar os arquivos xltx do Calendário Compacto. Se estiver usando uma versão anterior do Office no Windows, utilize este service pack para download a partir do site da Microsoft.

NOTA: O Calendário Compacto está salvo como um modelo do Excel (xltx). Se clicar duas vezes em um arquivo de modelo do Excel, ele abre uma cópia que salvará sem modificar o modelo mestre. Se quiser editar o modelo em si, deve abrí-lo como um modelo do MS Excel.

Por favor, note que é necessário o Microsoft Excel 2007 ou versão mais recente .Outros softwares como o Open Office, Google Docs, e outros podem importar a planilha Excel, mas devido as diferenças na maneira de lidar com as datas faz-se necessário certificar-se de que os calendários estarão corretos.

DOWNLOAD - BAIXE AQUI

Tags: 2014, Excel, tips, calendário, calendar, download, David Seah, xltx, Office, MS Office, 

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,

VBA Tips - Avalia o endereço do email - Validating An Email Address

Termo de Responsabilidade

Que tal validar um endereço de e-mail ou uma lista deles?

A função é esta: AvalMail ("bernardess@gmail.com")

Function AvalMail (ByVal EAddress As String) As Boolean

    ' Variáveis dimensionadas.

    Const AllowChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz._-"

    Dim UserName As String

    Dim ServerName As String

    Dim x As Long

    Dim i As Integer

    

    'Validate email address.

    Let x = InStr(1, EAddress, "@")

    

    If x = 0 Then GoTo BadAddress

    If InStr(x + 1, EAddress, "@") > 0 Then GoTo BadAddress

    

    Let UserName = Left$(EAddress, x - 1)

    Let ServerName = Right$(EAddress, Len(EAddress) - x)

    

    If Left$(UserName, 1) = "." Or Right$(UserName, 1) = "." Then GoTo BadAddress

    If Left$(ServerName, 1) = "." Or Right$(ServerName, 1) = "." Or InStr(1, ServerName, ".") = 0 Then GoTo BadAddress

    

    For i = 1 To Len(UserName)

        If InStr(1, AllowChars, Mid$(UserName, i, 1)) = 0 Then GoTo BadAddress

    Next

    

    For i = 1 To Len(ServerName)

        If InStr(1, AllowChars, Mid$(ServerName, i, 1)) = 0 Then GoTo BadAddress

    Next

    

    Let AvalMail = True

    Exit Function

BadAddress:

    Let AvalMail = False

End Function

References:

Tags: VBA, Tips, email, validade, avalia, checa, valida


 

VBA Tips - Verifica se uma aplicação está respondendo - Test if an application is responding and terminate application

Termo de Responsabilidade

Que tal verificar se uma aplicação está respondendo e em caso positivo finalizá-la?

Option Explicit

Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, pdwResult As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 

'Purpose     :  Terminates an application by finding the process ID of a windows handle.

'Inputs        :  lHwnd               The application window handle

'Outputs     :  Returns True if succeeds

'Notes        :  If you know the applications process ID then you need only call the last three lines of this routine.

Function ApplicationTerminate (lHwnd As Long) As Boolean

    Dim lPid As Long, lReturn As Long, lhwndProcess As Long

    Const PROCESS_ALL_ACCESS = &H1F0FFF

    'Get the PID (process ID) from the application handle

    Let lReturn = GetWindowThreadProcessId(lHwnd, lPid)

    'Terminate the application

    Let lhwndProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPid)

    Let ApplicationTerminate = (TerminateProcess(lhwndProcess, 0&) <> 0)

    Let lReturn = CloseHandle(lhwndProcess) 

End Function

'Purpose     :  Tests the status of an application

'Inputs        :  lHwnd               The application window handle

'                   [lWaitTimeOut]      The time in ms to wait for the application to respond

'Outputs     :  Returns True if application is responding, else returns

'                   false if the application is not responding

'Notes        :  SMTO_ABORTIFHUNG Returns without waiting for the time-out period to elapse if the receiving

'                   process appears to be in a "hung" state.

'                   SMTO_BLOCK Prevents the calling thread from processing any other requests until the function returns.

Function ApplicationResponding (lHwnd As Long, Optional lWaitTimeOut As Long = 2000) As Boolean

    Dim lResult As Long

    Dim lReturn As Long

    Const SMTO_BLOCK = &H1, SMTO_ABORTIFHUNG = &H2, WM_NULL = &H0

    

    Let lReturn = SendMessageTimeout(lHwnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, lWaitTimeOut, lResult)

    

    If lReturn Then

        Let ApplicationResponding = True

    Else

        Let ApplicationResponding = False

    End If

End Function

'Demonstration routine

Sub Test()

    Dim lHwnd As Long

    'Find an instance of internet explorer

    'I used IE to test it as it only takes about 2 mins before it hangs!

    Let lHwnd = FindWindow("IEFrame", vbNullString)

    If lHwnd Then

        If ApplicationResponding(lHwnd) = False Then

            'Application is not responding

            If ApplicationTerminate(lHwnd) = True Then

                MsgBox "Successfully terminated application"

            End If

        End If

    End If

End Sub

References:

Tags: VBA, Tips, application, responding, stop, close, terminate

 

VBA Tips - Como fazer Gradientes - How to Make Gradients

Termo de Responsabilidade

O efeito gradiente é muito bonito quando utilizado com moderação em alguns objetos. O código abaixo vai evocar um gradiente em cada formulário ou picturebox ou, eventualmente, qualquer objeto que tenha uma propriedade hDC.

Basta executar a SUB DrawGradient, passando os seguintes valores:

lDestHDC - O hDC do objeto que você deseja desenhar a

lDestWidth - A largura da Gradiente

lDestHeight - A altura da Gradiente

lStartColor - A cor do gradiente começa com

lEndColor - A cor do gradiente termina com

iStyle - 0 para a esquerda para a direita ou gradiente de 1 para cima para baixo gradiente.

Crie um novo módulo e insira este código:

Type RECT

   Left As Long

   Top As Long

   Right As Long

   Bottom As Long

End Type

Declare Function CreateSolidBrush Lib "gdi32" _

  (ByVal crColor As Long) As Long

Declare Function DeleteObject Lib "gdi32" _

  (ByVal hObject As Long) As Long

Declare Function FillRect Lib "user32" _

  (ByVal hDC As Long, lpRect As RECT, _

  ByVal hBrush As Long) As Long

Public Sub DrawGradient (lDestHDC As Long, _

  lDestWidth As Long, lDestHeight As Long, _

  lStartColor As Long, lEndColor As Long, _

  iStyle As Integer)

   Dim udtRect As RECT

   Dim iBlueStart As Integer

   Dim iBlueEnd As Integer

   Dim iRedStart As Integer

   Dim iRedEnd As Integer

   Dim iGreenStart As Integer

   Dim iGreenEnd As Integer

   Dim hBrush As Long

   On Error Resume Next

   'Calculate the beginning colors

   Let iBlueStart = Int(lStartColor / &H10000)

   Let iGreenStart = Int(lStartColor - (iBlueStart * &H10000)) \ CLng(&H100)

   Let iRedStart = lStartColor - (iBlueStart * &H10000) - CLng(iGreenStart * CLng(&H100))

   'Calculate the End colors

   Let iBlueEnd = Int(lEndColor / &H10000)

   Let iGreenEnd = Int(lEndColor - (iBlueEnd * &H10000)) \ CLng(&H100)

   Let iRedEnd = lEndColor - (iBlueEnd * &H10000) - CLng(iGreenEnd * CLng(&H100))

   Const intBANDWIDTH = 1

   Dim sngBlueCur As Single

   Dim sngBlueStep As Single

   Dim sngGreenCur As Single

   Dim sngGreenStep As Single

   Dim sngRedCur As Single

   Dim sngRedStep As Single

   Dim iHeight As Integer

   Dim iWidth As Integer

   Dim intY As Integer

   Dim iDrawEnd As Integer

   Dim lReturn As Long

   Let iHeight = lDestHeight

   Let iWidth = lDestWidth

   Let sngBlueCur = iBlueStart

   Let sngGreenCur = iGreenStart

   Let sngRedCur = iRedStart

   'Calculate the size of the color bars

   If iStyle = 0 Then

      sngBlueStep = intBANDWIDTH * _

         (iBlueEnd - iBlueStart) / (iWidth - 60) * 15

      sngGreenStep = intBANDWIDTH * _

         (iGreenEnd - iGreenStart) / (iWidth - 60) * 15

      sngRedStep = intBANDWIDTH * _

         (iRedEnd - iRedStart) / (iWidth - 60) * 15

      With udtRect

         Let .Left = 0

         Let .Top = 0

         Let .Right = intBANDWIDTH + 2

         Let .Bottom = iHeight / 15 - 2

      End With

      Let iDrawEnd = iWidth

   ElseIf iStyle = 1 Then

      Let sngBlueStep = intBANDWIDTH * _

         (iBlueEnd - iBlueStart) / (iHeight - 60) * 15

      Let sngGreenStep = intBANDWIDTH * _

         (iGreenEnd - iGreenStart) / (iHeight - 60) * 15

      Let sngRedStep = intBANDWIDTH * _

         (iRedEnd - iRedStart) / (iHeight - 60) * 15

      With udtRect

         Let .Left = 0

         Let .Top = 0

         Let .Right = iWidth / 15 - 2

         Let .Bottom = intBANDWIDTH + 2

      End With

      Let iDrawEnd = iHeight

   End If

   'Draw the Gradient

   For intY = 0 To (iDrawEnd / 15) - 5 Step intBANDWIDTH

      Let hBrush = CreateSolidBrush(RGB(sngRedCur, sngGreenCur, sngBlueCur))

      Let lReturn = FillRect(lDestHDC, udtRect, hBrush)

      Let lReturn = DeleteObject(hBrush)

      Let sngBlueCur = sngBlueCur + sngBlueStep

      Let sngGreenCur = sngGreenCur + sngGreenStep

      Let sngRedCur = sngRedCur + sngRedStep

      If iStyle = 0 Then

         Let udtRect.Left = udtRect.Left + intBANDWIDTH

         Let udtRect.Right = udtRect.Right + intBANDWIDTH

      ElseIf iStyle = 1 Then

         Let udtRect.Top = udtRect.Top + intBANDWIDTH

         Let udtRect.Bottom = udtRect.Bottom + intBANDWIDTH

      End If

   Next

End Sub    

'--end code block

No evento de leitura do Form coloque este código (Set Autoredraw to true to reduce flickering while resizing the form.)

Let Me.AutoRedraw = True

DrawGradient Me.hDC, Me.Width, Me.Height, vbBlue, vbRed, 0  

'--end code block

No evento de resize do Form coloque este código

Cls

DrawGradient Me.hDC, Me.Width, Me.Height, vbBlue, vbRed, 0  

'--end code block

References:

Tags: VBA, Tips, gradient, gradiente

VBA Tips - Manipulando arquivos - All File Operations.

Termo de Responsabilidade

Desenvolver com o VBA prescinde o conhecimento de manipulação de arquivos. Copiar, mover, excluir, ver quantos têm disponível em determinado local, e assim por diante. Acredito que as funcionalidades reunidas abaixo serão muito úteis nesse respeito, para ampliar o seu conhecimento. Aproveite. Aahh e deixe seus comentários.

Crie um módulo e copie tudo isso para dentro dele:

Option Explicit

 Private Declare Function ShellExecute Lib "shell32.dll" Alias _

           "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _

           String, ByVal lpszFile As String, ByVal lpszParams As String, _

           ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

           Const SW_SHOWNORMAL = 1

           Const SE_ERR_FNF = 2&

           Const SE_ERR_PNF = 3&

           Const SE_ERR_ACCESSDENIED = 5&

           Const SE_ERR_OOM = 8&

           Const SE_ERR_DLLNOTFOUND = 32&

           Const SE_ERR_SHARE = 26&

           Const SE_ERR_ASSOCINCOMPLETE = 27&

           Const SE_ERR_DDETIMEOUT = 28&

           Const SE_ERR_DDEFAIL = 29&

           Const SE_ERR_DDEBUSY = 30&

           Const SE_ERR_NOASSOC = 31&

           Const ERROR_BAD_FORMAT = 11&

Function StartDoc (DocName As String) As Long

                   Dim Scr_hDC As Long

                   

                   Let Scr_hDC = GetDesktopWindow()

                   Let StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _

                   "", "C:\", SW_SHOWNORMAL)

End Function

     

Function File_Copy (strCopyFrom As String, strCopyTo As String)

       FileCopy strCopyFrom, strCopyTo

End Function

Function Current_Dir() As String

       Let Current_Dir = CurDir

End Function

Function Change_Dir (strChangeTo As String)

       ChDir strChangeTo

End Function

Function Change_Drive (strChangeTo As String) As String

       ChDrive (strChangeTo)

       

        Let Change_Drive = CurDir

End Function

Function File_Exists (strToCheck As String) As Integer       

       Dim retval As String

       

       Let retval = Dir$(strToCheck)

       

       If retval = strToCheck Then

               Let File_Exists = 1

       Else

               Let File_Exists = 0

       End If

End Function

Function File_Rename (strOldName As String, strNewName As String)

       Name strOldName As strNewName

End Function

Function File_Delete (strToDelete As String)

       Kill strToDelete

End Function

Function Create_Dir (strToCreate)

       MkDir strToCreate

End Function

Function Remove_Dir (strToRemove As String)

       RmDir strToRemove

End Function

Function File_Move (strMoveFrom As String, strMoveTo As String)

               Kill strMoveTo

               FileCopy strMoveFrom, strMoveTo

End Function

Function File_ReadLine (strToRead As String, LineNum As Integer) As String

       Dim intCtr As Integer

       Dim strValue As String

       Dim intFNum As Integer

       Dim intMsg As Integer 

       

       Let intFNum = FreeFile

       Open strToRead For Input As #intFNum

               

                 Let intCtr = LineNum

                 Input #intFNum, strValue

                 Let File_ReadLine = strValue

                                           

       Close #intFNum

       

End Function

Function Run_Application (strPathOfFile As String)

       Dim r As Long, msg As String

                   Let r = StartDoc (strPathOfFile)

                   If r <= 32 Then

                           'There was an error

                           Select Case r

                                   Case SE_ERR_FNF

                                           Let msg = "Arquivo não encontrado"

                                   Case SE_ERR_PNF

                                           Let msg = "Caminho não encontrado"

                                   Case SE_ERR_ACCESSDENIED

                                           Let msg = "Accesso protegido"

                                   Case SE_ERR_OOM

                                           Let msg = "Fora da memória"

                                   Case SE_ERR_DLLNOTFOUND

                                           Let msg = "DLL não encontrada"

                                   Case SE_ERR_SHARE

                                           Let msg = "Ocorreu uma violação de compartilhamento"

                                   Case SE_ERR_ASSOCINCOMPLETE

                                          Let msg = "Associação inválida ou incompleta de arquivo"

                                   Case SE_ERR_DDETIMEOUT

                                           Let msg = "DDE Time out"

                                   Case SE_ERR_DDEFAIL

                                           Let msg = "DDE transaction failed"

                                   Case SE_ERR_DDEBUSY

                                           Let msg = "DDE busy"

                                   Case SE_ERR_NOASSOC

                                           Let msg = "Nenhuma associação de arquivo para essa extensão"

                                   Case ERROR_BAD_FORMAT

                                           Let msg = "Invalid EXE file or error in EXE image"

                                   Case Else

                                           Let msg = "Erro desconhecido"

                           End Select                           

                   End If           

End Function

Function File_Time (strFileName As String) As String

       Dim strDate As String

       Dim intcount, intDateLen As Integer

       

       Let strDate = FileDateTime(strFileName)

       Let intcount = InStr(1, strDate, " ", vbTextCompare)

       Let intDateLen = Len(strDate)

       Let File_Time = Mid$(strDate, intcount + 1, intDateLen)       

End Function

Function File_Date (strFileName As String) As String

       Dim strDate As String

       Dim intcount As Integer

       

       Let strDate = FileDateTime (strFileName)

       Let intcount = InStr (1, strDate, " ", vbTextCompare)

       Let File_Date = CDate (Mid$(strDate, 1, intcount)

End Function

References:

Tags: VBA, Tips, File, files, archive, arquivo, arquivos, 

VBA Tips - Nome do computador - Computer Name

Termo de Responsabilidade

Talvez vc deseje ligar a execução de uma aplicação

'A função abaixo mostra qual o nome do computador atual 

Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long 

' Para usá-la use a função abaixo 

Function GetComputerName() As String 

Dim UserName As String * 255 

Call GetComputerNameA (UserName, 255) 

Let GetComputerName = Left$(UserName, InStr (UserName, Chr$(0)) - 1) 

End Function 

References:

Tags: VBA, Tips, Computer, name

VBA Tips - Criptografando e Decriptografando - Encode and [De]Coding Ascii

Termo de Responsabilidade

Talvez queira tornar um texto, um valor, o conteúdo de uma tabela, inteligível para outras pessoas que olhem para aqueles dados sem a sua autorização.

Isso pode ser feito ao abrir os dados antes de enviá-los a um relatório ou antes de abrir uma planilha ou enviar um e-mail, tanto faz. Certamente não é nenhum código de 128 bits, mas já dá prá você brincar, entender como faz e desenvolver o seu próprio algoritmo. Enjoy!

Public Function nEncript (Data As String, Optional Depth As Integer) As String

    Dim TempChar As String

    Dim TempAsc As Integer

    Dim NewData As String

    Dim vChar As Integer

    For vChar = 1 To Len(Data)

        Let TempChar = Mid$(Data, vChar, 1)

        Let TempAsc = Asc(TempChar)

        If Depth = 0 Then Depth = 40 'DEFAULT DEPTH

        If Depth > 254 Then Depth = 254

        Let TempAsc = TempAsc + Depth

        If TempAsc > 255 Then TempAsc = TempAsc - 255

        Let TempChar = Chr(TempAsc)

        Let NewData = NewData & TempChar

    Next vChar

    Let Encode = NewData

End Function

Public Function nDecript (Data As String, Optional Depth As Integer) As String

    Dim TempChar As String

    Dim TempAsc As Integer

    Dim NewData As String

    Dim vChar As Integer

    For vChar = 1 To Len(Data)

        Let TempChar = Mid$(Data, vChar, 1)

        Let TempAsc = Asc(TempChar)

        

        If Depth = 0 Then Depth = 40 'DEFAULT DEPTH

        If Depth > 254 Then Depth = 254

        

        Let TempAsc = TempAsc - Depth

        

        If TempAsc < 0 Then TempAsc = TempAsc + 255

        

        Let TempChar = Chr(TempAsc)

        Let NewData = NewData & TempChar

    Next vChar

    Decode = NewData

End Function

References:

Tags: VBA, Tips, Criptografando, Decriptografando, encode, 128 bits, 

 

VBA Tips - Desabilitando o [CTRL] + [ALT] + [DEL]

Termo de Responsabilidade

Como posso impedir que a combinação de teclas [CTRL] + [ALT] + [DEL] estejam ativas enquanto minhas aplicações rodam? 

No evento ao carregar do seu formulário inicial cole:

Call DesativaCtrlAltDel

Cole o código abaixo em um novo módulo:  

Public Declare Function GetCurrentProcessId _ Lib "kernel32" () As Long

Public Declare Function GetCurrentProcess _ Lib "kernel32" () As Long 

Public Declare Function RegisterServiceProcess _ Lib "kernel32" (ByVal dwProcessID As Long, _ ByVal dwType As Long) As Long 

Public Const RSP_SIMPLE_SERVICE = 1 

Public Const RSP_UNREGISTER_SERVICE = 0 

Public Sub DesativaCtrlAltDel() 

Dim pid As Long, reserv As Long 

Let pid = GetCurrentProcessId() 

Let reserv = RegisterServiceProcess (pid, RSP_SIMPLE_SERVICE) 

End Sub 

References:

Tags: VBA, Tips, [CTRL] + [ALT] + [DEL], key, stop

Office Tips: Smart Art - Criar um elemento gráfico SmartArt

Um elemento gráfico SmartArt é uma representação visual de suas informações que você pode criar com rapidez e facilidade, escolhendo entre vários layouts diferentes, para comunicar suas mensagens ou idéias com eficiência.

Visão geral de como criar um elemento gráfico SmartArt

A maior parte do conteúdo criado com os programas do 2007 Microsoft Office System é textual, embora o uso de ilustrações possa melhorar a compreensão e a memorização, além de incentivar uma ação. Criar ilustrações de qualidade profissional pode ser um desafio, especialmente se você não for um designer profissional ou não tiver condições para contratar um. Usando as versões anteriores do Microsoft Office, você poderá demorar para obter formas do mesmo tamanho e alinhadas corretamente, que dêem ao seu texto a aparência adequada, e para formatar manualmente as formas até adequá-las ao estilo geral do documento, em vez de se concentrar no conteúdo. Com o novo recurso do Versão do 2007 Office chamado elementos gráficos SmartArt e outros recursos novos, como temas, você pode criar ilustrações de qualidade profissional com apenas alguns cliques do mouse.

Você pode criar um elemento gráfico SmartArt no Microsoft Office Excel 2007, no Microsoft Office PowerPoint 2007, no Microsoft Office Word 2007 ou em um email do Microsoft Office Outlook 2007. Embora não possa criar um elemento gráfico SmartArt em outros programas do Versão do 2007 Office, você pode copiá-los e colá-los como imagens nesses programas.

Como as apresentações do Office PowerPoint 2007 costumam conter slides com listas com marcadores, você pode rapidamente converter um texto de slide em um elemento gráfico SmartArt. Além disso, você pode adicionar animação a um elemento gráfico SmartArt em apresentações do Office PowerPoint 2007.

Ao criar um elemento gráfico SmartArt, você precisa escolher um tipo, comoProcesso, Hierarquia, Ciclo ou Relação. O tipo é semelhante a uma categoria de elemento gráfico SmartArt e cada tipo contém vários layouts diferentes. Depois de escolher um layout, é fácil alterar o layout do elemento gráfico SmartArt. Grande parte do texto e do conteúdo, as cores, os estilos, os efeitos e a formatação do texto são transferidos automaticamente para o novo layout.

Quando você seleciona um layout, é exibido um texto de espaço reservado (como[Texto]), para que seja possível ver a aparência do elemento gráfico SmartArt. O texto de espaço reservado não é impresso nem exibido durante uma apresentação de slides. No entanto, as formas são sempre exibidas e impressas, a menos que você as remova. Você pode substituir o texto de espaço reservado pelo seu próprio conteúdo.

À medida que você adiciona e edita seu conteúdo no painel Texto, o elemento gráfico SmartArt é atualizado automaticamente, ou seja, as formas são adicionadas ou removidas como necessário. 

Você também pode adicionar e remover formas no elemento gráfico SmartArt para ajustar a estrutura do layout. Por exemplo, embora o layout Processo Básicoapareça com três formas, talvez seu processo só precise de duas formas ou até de cinco. À medida que você adiciona ou remove formas e edita o texto, a organização das formas e o texto contido nelas é atualizado automaticamente, mantendo a borda e o design originais do layout do elemento gráfico SmartArt. 

Para proporcionar rapidamente uma aparência de qualidade profissional e aperfeiçoar o elemento gráfico SmartArt, aplique um Estilo de SmartArt a ele.

 INÍCIO DA PÁGINA

O que considerar ao criar um elemento gráfico SmartArt

Antes de criar um elemento gráfico SmartArt, visualize o tipo e o layout ideais para exibir seus dados. O que você deseja transmitir com o gráfico? Você deseja obter uma aparência específica? Como você pode alternar layouts de maneira rápida e fácil, experimente outros layouts (de vários tipos) até encontrar aquele que melhor ilustre sua mensagem. Seu elemento gráfico deve ser claro e fácil de seguir. Experimente tipos diferentes de elemento gráficos SmartArt usando a tabela abaixo como ponto de partida. O objetivo da tabela é ajudá-lo a começar, e a lista não está completa.

OBJETIVO DO GRÁFICO	TIPO DE GRÁFICO
Mostrar informações não seqüenciais	Lista
Mostrar as etapas de um processo ou de um cronograma	Processo
Mostrar um processo contínuo	Ciclo
Mostrar uma árvore de decisão	Hierarquia
Criar um organograma	Hierarquia
Ilustrar conexões	Relação
Mostrar como as partes se relacionam com o todo	Matriz
Mostrar relações proporcionais com o maior componente da parte superior ou inferior	Pirâmide

Além disso, considere a quantidade de texto, porque ela costuma determinar o layout a ser usado e o número de formas que esse layout precisa conter. Em geral, os elementos gráficos SmartArt são mais eficientes quando a quantidade de texto e o número de formas são limitados a pontos principais. Grandes quantidades de texto podem distrair a atenção do apelo visual do elemento gráfico SmartArt e dificultar a transmissão visual da sua mensagem. No entanto, alguns layouts, como Trapezóide no tipo Lista, funcionam bem com grandes quantidades de texto.

Alguns layouts de elementos gráficos SmartArt contêm um número fixo de formas. Por exemplo, o layout Setas de Contrapeso do tipo Relação é criado para mostrar duas idéias ou dois conceitos opostos. Somente duas formas podem conter o texto, e o layout não pode ser alterado para exibir mais idéias ou conceitos.

Se você precisar transmitir mais de duas idéias, alterne para outro layout com mais de duas formas para texto, como o layout Pirâmide Básico do tipo Pirâmide. Lembre-se de que alterar layouts ou tipos de elemento gráficos SmartArt pode alterar o significado das informações. Por exemplo, um layout de elemento gráfico SmartArt com setas que apontam para a direita, como Processo Básico do tipoProcesso, tem um significado diferente de um elemento gráfico SmartArt com setas que formam um círculo, como Ciclo Contínuo do tipo Ciclo.

 INÍCIO DA PÁGINA

Criar um elemento gráfico SmartArt

1. Na guia Inserir, no grupo Ilustrações, clique em SmartArt.

2. Na caixa de diálogo Escolher Elemento Gráfico SmartArt, clique no tipo e no layout desejados.
3. Para digitar o texto, siga um destes procedimentos:
• Clique em uma forma no elemento gráfico SmartArt e digite o texto.
• Clique em [Texto] no painel Texto e, em seguida, digite ou cole o texto.
• Copie o texto de outro programa, clique em [Texto] e cole no painel Texto.

Se o painel Texto não estiver visível

Alterar as cores de um elemento gráfico SmartArt inteiro

Você pode aplicar variações de cores derivadas das cores de tema às formas no elemento gráfico SmartArt.

1. Clique no elemento gráfico SmartArt.
2. Em Ferramentas SmartArt, na guia Design, no grupo Estilos de SmartArt, clique em Alterar Cores.

3. Clique na variação de cor que deseja.

Aplicar um Estilo de SmartArt a um elemento gráfico SmartArt

O Estilo de SmartArt é uma combinação de vários efeitos, como estilo de linha, bisel ou 3D, que você aplica às formas do elemento gráfico SmartArt para criar uma aparência exclusiva e profissional.

1. Clique no elemento gráfico SmartArt.
2. Em Ferramentas SmartArt, na guia Design, no grupo Estilos de SmartArt, clique no Estilo de SmartArt desejado.

Para ver mais Estilos de SmartArt, clique no botão Mais .

Dicas    

• Se já houver um texto em um slide, você poderá converter o texto em um elemento gráfico SmartArt.
• Você também pode personalizar o elemento gráfico SmartArt adicionando formas individuais, removendo formas, movendo formas,redimensionando formas e formatando texto.
• Para começar com um layout em branco, exclua o texto de espaço reservado (como [Texto]) no painel Texto ou pressione CTRL+A e, em seguida, DELETE.

Referências: 

Tags:  Microsoft Office Excel 2007, PowerPoint 2007, Word 2007, Smartart, Tips,