Private Declare Function GetComputerName Lib "kernel32" Alias _ "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias _ "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Function GetUser() As String Dim UserName As String ' receives name of the user Dim slength As Long ' length of the string Dim RetVal As Long ' return value UserName = Space(255) ' room for 255 characters slength = 255 ' initialize the size of the string RetVal = GetUserName(UserName, slength) ' slength is now the length of the returned string UserName = Left(UserName, slength - 1) ' extract the returned info from the buffer User = UserName End Function
Private Type SYSTEMTIME
wYear As IntegerwMonth As IntegerwDayOfWeek As IntegerwDay As IntegerwHour As IntegerwMinute As IntegerwSecond As IntegerwMilliseconds As Integer
End TypePrivate Declare Sub GetSystemTime Lib "kernel32" _(lpSystemTime As SYSTEMTIME)Public Function TimeToMillisecond() As String
Dim tSystem As SYSTEMTIMEDim sRetOn Error Resume NextGetSystemTime tSystemsRet = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & _":" & tSystem.wMillisecondsTimeToMillisecond = sRet
End Function
Talvez porque fosse de uma agência de propaganda. Enfim, alguns toques de requinte podem abrir as portas para a sua aplicação ser aceita, distribuida e comentada. Seguem códigos:Recurso simples? Sim.O acesso era mais demorado? Sim, mas o usuário gostou muito.
Open an Excel workbookSelect Tools/Macro/Visual Basic EditorIn the VBE window, select View/Project ExplorerSelect the 'ThisWorkbook' Module, copy and paste the code for it from aboveSelect Insert/Module, copy and paste the code for module1 into this module.Now select File/Close and Return To Microsoft ExcelSave your work and close the workbook.
Option ExplicitPrivate Sub Workbook_Open()Application.Caption = " My Personalized Workbook"ChangeApplicationIconEnd Sub
Option ExplicitDeclare Function GetActiveWindow32 Lib "USER32" Alias _"GetActiveWindow" () As IntegerDeclare Function SendMessage32 Lib "USER32" Alias _"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ByVal wParam As Long, ByVal lParam As Long) As LongDeclare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _"ExtractIconA" (ByVal hInst As Long, _ByVal lpszExeFileName As String, _ByVal nIconIndex As Long) As Long
Sub ChangeApplicationIcon()Dim Icon&'*****Change Icon To Suit*******Const NewIcon$ = "Notepad.exe"'*****************************Icon = ExtractIcon32(0, NewIcon, 0)SendMessage32 GetActiveWindow32(), & H80, 1, Icon '< 1 = big IconSendMessage32 GetActiveWindow32(), & H80, 0, Icon '< 0 = small IconEnd Sub
IsNetConnectViaLANIsNetConnectViaModemIsNetConnectViaProxyIsNetConnectOnlineIsNetRASInstalledGetNetConnectString
Option Explicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Copyright ©1996-2011 VBnet/ Randy Birch, All Rights Reserved.' Some pages may also contain other copyrights by the author.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Distribution: You can freely use this code in your own' applications, but you may not reproduce' or publish this code on any web site,' online service, or distribute as source' on any media without express permission.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Private Declare Function InternetGetConnectedState Lib "wininet" _(ByRef dwflags As Long, _ByVal dwReserved As Long) As Long'Local system uses a modem to connect to the Internet.Private Const INTERNET_CONNECTION_MODEM As Long = &H1'Local system uses a LAN to connect to the Internet.Private Const INTERNET_CONNECTION_LAN As Long = &H2'Local system uses a proxy server to connect to the Internet.Private Const INTERNET_CONNECTION_PROXY As Long = &H4'No longer used.Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8Private Const INTERNET_RAS_INSTALLED As Long = &H10Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40Private Sub Command1_Click()Let Text1.Text = IsNetConnectViaLAN()Let Text2.Text = IsNetConnectViaModem()Let Text3.Text = IsNetConnectViaProxy()Let Text4.Text = IsNetConnectOnline()Let Text5.Text = IsNetRASInstalled()Let Text6.Text = GetNetConnectString()End SubFunction IsNetConnectViaLAN() As BooleanDim dwflags As Long'pass an empty variable into which the API will'return the flags associated with the connectionCall InternetGetConnectedState(dwflags, 0&)'return True if the flags indicate a LAN connectionIsNetConnectViaLAN = dwflags And INTERNET_CONNECTION_LANEnd FunctionFunction IsNetConnectViaModem() As BooleanDim dwflags As Long'pass an empty variable into which the API will'return the flags associated with the connectionCall InternetGetConnectedState(dwflags, 0&)'return True if the flags indicate a modem connectionLet IsNetConnectViaModem = dwflags And INTERNET_CONNECTION_MODEMEnd FunctionFunction IsNetConnectViaProxy() As BooleanDim dwflags As Long'pass an empty variable into which the API will'return the flags associated with the connectionCall InternetGetConnectedState(dwflags, 0&)'return True if the flags indicate a proxy connectionLet IsNetConnectViaProxy = dwflags And INTERNET_CONNECTION_PROXYEnd FunctionFunction IsNetConnectOnline() As Boolean'no flags needed here - the API returns True'if there is a connection of any typeLet IsNetConnectOnline = InternetGetConnectedState(0&, 0&)End FunctionFunction IsNetRASInstalled() As BooleanDim dwflags As Long'pass an empty variable into which the API will'return the flags associated with the connectionCall InternetGetConnectedState(dwflags, 0&)'return True if the flags include RAS installedLet IsNetRASInstalled = dwflags And INTERNET_RAS_INSTALLEDEnd FunctionFunction GetNetConnectString() As StringDim dwflags As LongDim msg As String'build a string for displayIf InternetGetConnectedState(dwflags, 0&) ThenIf dwflags And INTERNET_CONNECTION_CONFIGURED ThenLet msg = msg & "Você tem uma conexão de rede configurada." & vbCrLfEnd IfIf dwflags And INTERNET_CONNECTION_LAN ThenLet msg = msg & "O sistemas local conecta-se a Internet via LAN"End IfIf dwflags And INTERNET_CONNECTION_PROXY ThenLet msg = msg & ", e usuários no Servidor de Proxy. "ElseLet msg = msg & "."End IfIf dwflags And INTERNET_CONNECTION_MODEM ThenLet msg = msg & "O sistema local usa um modem para conectar-se a Internet. "End IfIf dwflags And INTERNET_CONNECTION_OFFLINE ThenLet msg = msg & "A conexão está offline. "End IfIf dwflags And INTERNET_CONNECTION_MODEM_BUSY ThenLet msg = msg & "O sistema de Modem local está ocupado com uma conexão non-Internet. "End IfIf dwflags And INTERNET_RAS_INSTALLED ThenLet msg = msg & "Serviço de Acesso Remoto instalado neste sistema."End IfElseLet msg = "Não conectado a Internet agora."End IfLet GetNetConnectString = msgEnd Function
Private Sub Workbook_Open()' Author: Date: Contact: URL:' André Bernardes 02/03/2011 09:40 bernardess@gmail.com http://al-bernardes.sites.uol.com.br/' Application: ***' Ao abrir o formulário.' Listening: - .' Re-escrito/Atualizado em: .Let Application.ScreenUpdating = FalseLet Application.Caption = ".: Minha Aplicação"Let Application.StatusBar = "A&A - In Any Place"' Abre um formulário.
frmSplash.Show
Call ChangeAppIconLet Application.ScreenUpdating = TrueEnd Sub
Option Explicit
Declare Function GetActiveWindow32 Lib "USER32" Alias "GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongSub ChangeAppIcon()
' Author: Date: Contact: URL:' André Bernardes 02/03/2011 08:14 bernardess@gmail.com http://al-bernardes.sites.uol.com.br/' Application:' Modification of code from Excel Experts E-Letter Archives.' Original code By Jim Rech can be found by following this' Listening: - .' Re-escrito/Atualizado em: .Dim Icon&' Change Icon To Suit
Const NewIcon$ = "C:\Bernardes\Application.ico"Let Icon = ExtractIcon32(0, NewIcon, 0)SendMessage32 GetActiveWindow32(), &H80, 1, Icon '< 1 = big Icon
SendMessage32 GetActiveWindow32(), &H80, 0, Icon '< 0 = small IconEnd Sub
