Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Desenvolvimento em Excel - Inicio (Dicas + Anexo)

Tutoriais elaborados da comunidade
Avatar do usuário
kedim43
Colaborador
Colaborador
Mensagens: 45
Registrado em: Dom Fev 05, 2012 3:12 pm
Localização: Goias
Contato:

Desenvolvimento em Excel - Inicio (Dicas + Anexo)

Mensagem por kedim43 »

Boa noite Galera.
Bom... vou iniciar uma serie de dicas com imagens e detalhes de como tudo será realizado!
Iniciaremos pelo começo.
Acredito que, será bem legal a todos conhecer como tudo é feito. Baixem o modelo e tudo que será utilizado.
Para facilitar... o mesmo está compactado e é somente um modelo para que vocês possam já utilizar e ver tudo que será explicado ao longo de muitos dias... fiquem firmes... sempre que der... deixo uma dica nova e para aqueles que queiram as senhas de acesso... Entrem em contato!

Uma palhinha de tudo...
Na Tela de Login
Usuário = CLEUDIMAR
Senha = 212826
Brinquem a vontade!

Não se esqueçam... mantenham tudo na mesma pasta como está no anexo... a brincadeira vai começar!

1ª Dica... Códigos de Programação!
Não tenham medo de errar! Vão descobrir que, errando sempre aprendemos formas de como a lógica de programação é interpretada pelo leitor.
* Código do Splash:
Crie um formulário dentro do VBA e insira o código abaixo.
Option Explicit
 
Private Declare Function GetActiveWindow Lib "user32" () As Long
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long
 
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
 
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
 
Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean


Private Sub UserForm_Activate()
     
    Running = True
    Call Transparency
     
End Sub
 
Private Sub Transparency()
     
    Dim MyTimer         As Double
     
    DoEvents
    MyTimer = Timer
    Do
        Do
        Loop While Timer - MyTimer < 0.04
        MyTimer = Timer
        Transparancy = Transparancy - 1
        If Transparancy < 0 Then
            Unload Me
        Else
            Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
        End If
        DoEvents
    Loop While Running
     
End Sub
 
Private Sub SemiTransparent(ByVal intLevel As Integer)
     
    Dim lngWinIdx       As Long
     
    hWnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
    SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0, (255 * intLevel) / 100, LWA_ALPHA
     
End Sub

 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     
    Running = False

    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
    
    End Sub
Private Sub UserForm_Initialize()
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
    
    
' Metodo Invisivel do Excel
Application.Visible = False

Application.OnTime Now + TimeValue("00:00:04"), "FechaForm"


End Sub
* Código para criar atalho:
Dentro do VBA, crie um modulo com o nome - Criar_Atalho.
Dentro do modulo, insira o código abaixo...
Sub CreateDesktopShortcut()
'   Msgbox string variables
    Dim szMsg As String
    Dim szStyle As String
    Dim szTitle As String
    
'   Change here for the icon's name
    Const szIconName As String = "/Sistema All Control.ico"
    
'   Constant string values, you can replace "Desktop"
'   with any Special Folders name to create the shortcut there
    Const szlocation As String = "Desktop"
    Const szLinkExt As String = ".lnk"

'   Object variables
    Dim oWsh As Object
    Dim oShortcut As Object
        
'   String variables
    Dim szSep As String
    Dim szBookName As String
    Dim szBookFullName As String
    Dim szPath As String
    Dim szDesktopPath As String
    Dim szShortcut As String
    
'   Initialize variables
    szSep = Application.PathSeparator
    szBookName = szSep & ThisWorkbook.Name
    szBookFullName = ThisWorkbook.FullName
    szPath = ThisWorkbook.Path

    On Error GoTo ErrHandle
'   The WScript.Shell object provides functions to read system
'   information and environment variables, work with the registry
'   and manage shortcuts
    Set oWsh = CreateObject("WScript.Shell")
    szDesktopPath = oWsh.SpecialFolders(szlocation)
        
'   Get the path where the shortcut will be located
    szShortcut = szDesktopPath & szBookName & szLinkExt
    
'   Make it happen
    Set oShortcut = oWsh.CreateShortCut(szShortcut)
    
'   Link it to this file
    With oShortcut

         .TargetPath = szBookFullName
        .IconLocation = szPath & szIconName
        .Save
    End With
    
'   Explicitly clear memory
    Set oWsh = Nothing
    Set oShortcut = Nothing
    
    Exit Sub
       
'   or if it wasn't
ErrHandle:
    szMsg = "Erro ao criar Icone no Desktop!"
    szStyle = 48
    szTitle = "Erro!"
    
    MsgBox szMsg, szStyle, szTitle
End Sub

* Para chamar todas as ações, dentro da Opção - Esta Pasta de Trabalho... Cole o código abaixo.
Private Sub Workbook_Activate()
Call Formatar_Tela_Menu
Call RetiraXdaBarra
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Formatar_Tela_Normal
Call RepoeXdaBarra
End Sub

Private Sub Workbook_Deactivate()
Call Formatar_Tela_Normal
Call RepoeXdaBarra
End Sub

Private Sub Workbook_Open()

ActiveSheet.Unprotect

Call CreateDesktopShortcut
Call Formatar_Tela_Menu
Call RetiraXdaBarra

Worksheets(1).ScrollArea = "A1:U36"

Form_splash.Show
End Sub
Agora, vamos a uma parte bem legal que, fará sua aplicação ficar mais apresentada e bem bacana...
Vamos brincar um pouco com os Ribbons do Excel. Isso mesmo! Vamos brincar com esta parte!
* Crie um modulo com o nome de Ribbons e cole o código abaixo..
Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
Declare Function GetWindowLong32 Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Integer, ByVal nIndex As Integer) As Long
Declare Function SetWindowLong32 Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Integer, ByVal nIndex As Integer, _
        ByVal dwNewLong As Long) As Long
        
Global Const GWL_STYLE = (-16)
Global Const WS_SYSMENU = &H80000


Sub Formatar_Tela_Menu()


With Application

'Desabilita eventos
.ScreenUpdating = False
.EnableEvents = False


'Ações de execução
.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
.DisplayFormulaBar = False
.DisplayStatusBar = False
.Caption = "Sistema All Control"

'Ação das barras de GridLine do Excel
With ActiveWindow

.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
.DisplayHeadings = False
.DisplayGridlines = False

End With


'Habilita eventos
.ScreenUpdating = True
.EnableEvents = True


End With


End Sub

Sub Formatar_Tela_Normal()


With Application

'Desabilita eventos
.ScreenUpdating = False
.EnableEvents = False


'Ações de execução
.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)"
.DisplayFormulaBar = True
.DisplayStatusBar = True
.Caption = ""


'Ação das barras de GridLine do Excel
With ActiveWindow

.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
.DisplayHeadings = True
.DisplayGridlines = True

End With


'Habilita eventos
.ScreenUpdating = True
.EnableEvents = True


End With


End Sub
Sub RepoeXdaBarra()

    Application.ScreenUpdating = True
    Dim WindowStyle As Long
    Dim hWnd As Integer
    Dim WindowName As String
    Dim Result As Variant

    WindowName = Application.Caption
    hWnd = FindWindow32(0&, ByVal WindowName)
    WindowStyle = GetWindowLong32(hWnd, GWL_STYLE)
    WindowStyle = WindowStyle Or WS_SYSMENU
    Result = SetWindowLong32(hWnd, GWL_STYLE, WindowStyle)


End Sub

Sub RetiraXdaBarra()

Application.ScreenUpdating = False

    Dim WindowStyle As Long
    Dim hWnd As Integer
    Dim WindowName As String
    Dim Result As Variant

    WindowName = Application.Caption
    hWnd = FindWindow32(0&, ByVal WindowName)
    WindowStyle = GetWindowLong32(hWnd, GWL_STYLE)
    WindowStyle = WindowStyle And (Not WS_SYSMENU)
    Result = SetWindowLong32(hWnd, GWL_STYLE, WindowStyle)

    'Força a barra de títulos a se atualizar, Ocultando os Botões
    Application.Caption = "Sistemas Integrados (Copyright © 2016)"
    ActiveWindow.Caption = " Desenvolvido Por: XcellSolutions "

End Sub

Bom! Aqui finalizamos nossa 1ª Dica de como tudo é feito no modelo em anexo a este post!
Baixem o mesmo! Aproveitem a oportunidade de conhecer tudo em detalhes e, onde você vai ter todos os detalhes e ir aplicando tudo em seus projetos!
Lembro que, todos os nomes são fictícios! Alterem conforme seu projeto! Valeu Galera! Grande Abraço.
Anexos
Sistema All Control.rar
(3.5 MiB) Baixado 765 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder