 | ||||||
| ||||
| ||||||
Please check back soon, when I have updated what will be going in here!
4) Browse Folders (Various methods)
Coming SOON!!
8) Icons in Userform caption
9) Using Html, Java, VBS coding in UserFrom
Xcel
This page was last updated on: March 22, 2009
You are visitor number:
Display a Screen Saver in Excel;
The following technique will display a screen saver in Excel. Besides the "Can it be Done"
aspect of this, you will find it useful for when you want to lock a user out of your application.
There are 2 techniques to this:
1) Starting the default ScreenSaver
2) Starting an embedded ScreenSaver
With 1) you can start it and lock it up with a password.
Note, if the Users default setting is set-up with a password then you will be prompted anyway.
With 2) embedding it within the spreadsheet allows you to send the spreadsheet to anyone with the Screensaver of your choice. With a bit of imagination you could use screen rendering screensavers to get special effects on your spreadsheet eg Using the Science SS with glass effects gives good effects. Note although it is embeded, it still uses the system set-up eg for the passord...........
eg.
Get examples HERE
Here is an idea you could use as a prank or security.
Show the dreaded Blue screen of Death (BSOD) within your Excel application.....
A ScreenSaver for this is available here:
Bluescreen runs on Windows NT 4.0, Windows 2000, Windows XP and Windows 9x (it requires DirectX - Read the Readme file for 9x).
On NT 4.0 installations it simulates chkdsk of disk drives with errors!
On Win2K and Windows 9x it presents the Win2K startup splash screen, complete with rotating progress band and progress control updates!
On Windows XP it presents the XP startup splash screen with progress bar!
1) To Run your default screensaver code:
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function BlockInput Lib "user32" ( _
ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
Private Const WM_SYSCOMMAND As Long = &H112&
Private Const SC_SCREENSAVE As Long = &HF140&
Sub StartScreenSaver()
'// Starts Default ScrnSaver
'// By Ivan F Moala
Dim lRet As Long
lRet = SendMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
'// Make sure SS displays
DoEvents
'// Disable any inputs via mouse or keyboard
BlockInput True
'// pause 10 seconds before unblocking it
Sleep 10000
'// Enable inputs via mouse or keyboard
BlockInput False
End Sub
2) To set-up an embeded Screensaver:
Here's How;
.
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function BlockInput Lib "user32" ( _
ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
Private Const WM_SYSCOMMAND As Long = &H112&
Private Const SC_SCREENSAVE As Long = &HF140&
Sub Run_Embeded_SS()
Dim ScrnS As Object
'// Show ScreenSaver = Shapes("Object 8")
'// Note 8 as Oleobject index, next one will be 9!
Application.DisplayAlerts = False
Set ScrnS = Sheet1.OLEObjects("Object 8")
ScrnS.Verb
Set ScrnS = Nothing
Application.DisplayAlerts = True
BlockInputs 10
End Sub
Sub BlockInputs(tmDelaySecs As Long)
DoEvents
'// Disable any inputs mouse/keyboard
BlockInput True
'// pause tmDelaySecs * 1000 = seconds before unblocking it
Sleep tmDelaySecs * 1000
'// Enable inputs mouse/keyboard
BlockInput False
End Sub
FTP in Excel:
The following routine is an example of how to FTP within an Excel application.
Note: there are other ways, but this offers more control that you can't get by any other means other then from a dedicated FTP program. For this I would suggest;
WCL_FTP - new version 1.3 - Windows Command Line FTP. (Freeware!)
WCL_FTP is a basic Windows Command Line FTP program. It was designed to do a very limited set of FTP commands, without user intervention. It is completely command line driven.
What this means is that it is perfect for batch or automated programming or adding FTP capability to programs that need it. It works seamlessly with other programs, even taking a parameter on the command line that specifies the caption at the top or the ftp
form, so it becomes part of your program. To use WCL_FTP, you simply create a shortcut to the program with the parameters as follows in the command line to start the program, or use a batch file to start it.
Or one I use;
WS_FTP Pro for Windows 95/98/NT/2000 (X86 Version)
Available here: http://www.ipswitch.com
Option Explicit
'//
'// Dedicated to my Friend Colo
'// Some of the code from http://www.allapi.net
'// spec thanks to Joacim Andersson 29 July 2001
'// Amendments by Ivan F Moala 28 Sept 2002
'//
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_PASSIVE = &H8000000 '// used for FTP connections
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 '// use registry configuration
Private Const INTERNET_OPEN_TYPE_DIRECT = 1 '// direct to net
Private Const INTERNET_OPEN_TYPE_PROXY = 3 '// via named proxy
Private Const _
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 '// prevent using java/script/INS
Private Const MAX_PATH = 260
Private Const INTERNET_INVALID_PORT_NUMBER = 0 '// use the protocol-specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21 '// default for FTP servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70 '// " " gopher "
Private Const INTERNET_DEFAULT_HTTP_PORT = 80 '// " " HTTP "
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443 '// " " HTTPS "
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080 '// default for SOCKS firewall servers.
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" _
Alias "InternetConnectA" ( _
ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUserName As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" _
Alias "InternetOpenA" ( _
ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
Alias "FtpSetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" _
Alias "FtpGetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszCurrentDirectory As String, _
lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" _
Alias "FtpCreateDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" _
Alias "FtpRemoveDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" _
Alias "FtpRenameFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszExisting As String, _
ByVal lpszNew As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" _
Alias "FtpGetFileA" ( _
ByVal hConnect As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" _
Alias "FtpPutFileA" ( _
ByVal hConnect As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" _
Alias "FtpFindFirstFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags As Long, _
ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" _
Alias "InternetFindNextFileA" ( _
ByVal hFind As Long, _
lpvFindData As WIN32_FIND_DATA) As Long
Private Const PassiveConnection As Boolean = True
Private Const FtpServer As String = "ftp.census.gov/pub/"
Private Const ERROR_NO_MORE_FILES = 18&
'// Logon constants
Private Const strLogon As String = "anonymous"
Private Const strPwd As String = "guest"
'// Some ftp sites to test
'// You will need your OWN Ftp Site
'// To Test this on as you will be
'// Creating / deleting Dir
'//
Sub Ftp_Test()
Dim hConnection As Long, hOpen As Long, sOrgPath As String
'// open an internet connection
hOpen = InternetOpen("Colo Example", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)
'// connect to the FTP server
hConnection = InternetConnect(hOpen, _
FtpServer, _
INTERNET_DEFAULT_FTP_PORT, _
strLogon, _
strPwd, _
INTERNET_SERVICE_FTP, _
IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), _
0)
'// create a buffer to store the original directory
sOrgPath = String(MAX_PATH, 0)
'// get the directory
FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
'// create a new directory 'testing'
FtpCreateDirectory hConnection, "testing"
'// set the current directory to 'root/testing'
FtpSetCurrentDirectory hConnection, "testing"
'// upload the file 'README.htm'
FtpPutFile hConnection, "C:\README.htm", "README.htm", FTP_TRANSFER_TYPE_UNKNOWN, 0
'// rename 'README.htm' to 'Colo.htm'
FtpRenameFile hConnection, "README.htm", "Colo.htm"
'// enumerate the file list from the current directory ('root/testing')
EnumFiles hConnection
'// retrieve the file from the FTP server
FtpGetFile hConnection, "Colo.htm", _
"c:\Colo.htm", _
False, _
0, _
FTP_TRANSFER_TYPE_UNKNOWN, _
0
'// delete the file from the FTP server
FtpDeleteFile hConnection, "Colo.htm"
'// set the current directory back to the root
FtpSetCurrentDirectory hConnection, sOrgPath
'// remove the direcrtory 'testing'
FtpRemoveDirectory hConnection, "testing"
'// close the FTP connection
InternetCloseHandle hConnection
'// close the internet connection
InternetCloseHandle hOpen
End Sub
Public Sub EnumFiles(hConnection As Long)
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
'//
'//
'// create a buffer
pData.cFileName = String(MAX_PATH, 0)
'// find the first file
hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
'// if there's no file, then exit sub
If hFind = 0 Then Exit Sub
'// show the filename
MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
Do
'// create a buffer
pData.cFileName = String(MAX_PATH, 0)
'// find the next file
lRet = InternetFindNextFile(hFind, pData)
'// if there's no next file, exit do
If lRet = 0 Then Exit Do
'// show the filename
MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
Loop
'// close the search handle
InternetCloseHandle hFind
End Sub
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'// get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'// create a buffer
sErr = String(lenBuf, 0)
'// retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'// show the last response info
MsgBox "Error " & CStr(lErr) & ": " & sErr, vbOKOnly + vbCritical
End Sub
VIRUS CHECKER:
Here is a routine to run within Excel to check your Anti-Virus software.
| ||||||
Recording a Wave sound in Excel:
You may or maynot know that you can play a sound within Excel. But you can ALSO RECORD a sound as well! The Windows API provides two methods for controlling and issuing commands for the multimedia capabilities of your system. We are going to be using these to Record and PlayBack a sound within Excel.
The first is a series of low-level functions.
eg
Private Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
The second is the Windows Media Control Interface (MCI).
eg
Private Declare Function mciSendString Lib "winmm" _
Alias "mciSendStringA" ( _
ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
The media control interface provides a high-level, device-independent interface for controlling multimedia devices on your system such as audio hardware, movie players, video disc and videotape players, and
is the recommended method for controlling multimedia devices in Windows.
The two methods for issuing MCI commands:
command messages and command strings.
Command messages are sent by filling a memory structure and passing it to the MCI system.
Command strings are English-like strings that are sent to the MCI system and parsed to determine the action to
be taken. Command strings provide the same functionality as command messages with a simpler format.
The following example shows how to use the media control interface using MCI command strings to record a wave file within Excel and play it back. Because we are using the API's the actual recording
interface (Sound Recorder) is not visible, we are dealing purely with the Interface code itself.
MCI uses device drivers to interpret and execute high-level MCI commands. Applications can communicate with MCI device handlers by sending messages or command strings.
ISSUING A COMMAND STRING
Each command string consists of three elements:
commanddeviceargumentse.g.
play cdaudio from 1000 to 10000This would be issued using something like MCISendString e.g.
MCISendString("play cdaudio from 1000 to 10000")
Note it is possible to give a device an alias in the open command string and then use this alias in all the other commands a bit like a handle.
Valid device strings can be found in your [mci] section of SYSTEM.INI, they list the device types
installed and the associated driver files
eg
[mci]
cdaudio=mcicda.drv = [CD Audio player]
sequencer=mciseq.drv = [MIDI sequencer]
waveaudio=mciwave.drv = [Audio device eg Windows Media player]
avivideo=mciavi.drv
videodisc=mcipionr.drv
vcr=mcivisca.drv
MPEGVideo=mciqtz.drv
MPEGVideo2=mciqtz.drv
Here is the Routine to Record and Playback the recorded sound.
Note: Also included a Playback Loop AND Stop Sound, as the interface is NOT visible you CANNOT stop the sound while in a loop.
Get Copy Code here
Option Explicit
'//
'// Use MCI functions to record a WAV file.
'// The main MCI function is mciSendString, that sends command
'// strings to the system MCI device and executes them.
'// The device that the command is sent to is specified in the command string.
'// In this case it is the waveaudio
'//
Private Declare Function mciSendString Lib "winmm" _
Alias "mciSendStringA" ( _
ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Declare Function mciExecute Lib "winmm" ( _
ByVal lpstrCommand As String) As Long
Private Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
'// Sound constants
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10
'// Define your Alias handle
Private Const strAlias As String = "RcrdWavFile "
Private Const strOpenCmd As String = "Open new type waveaudio alias " & strAlias
Private Const strRecordCmd As String = "Record " & strAlias
Private Const strTimeCmd As String = "Record " & strAlias & " to "
'// Note the time length in msecs comes before this const eg 10000 WAIT
Private Const strWaitCmd As String = " WAIT"
Private Const strSaveCmd As String = "Save " & strAlias
Private Const strCloseCmd As String = "Close " & strAlias
'// Save recorded sound as
Private Const strSaveAs As String = "C:\test.wav"
Sub TestRecording()
Dim strCommand As String
Dim ExecCmd As Long
Dim tWait
'// Define Time to record for in Secs
tWait = 5
'// Open default recorder > Dosen't Show
ExecCmd = mciSendString(strOpenCmd, vbNullString, 0, 0&)
'// Start recording
ExecCmd = mciSendString(strRecordCmd, vbNullString, 0, 0&)
'// Set the Recording time
ExecCmd = mciSendString(strTimeCmd & (tWait * 1000) & strWaitCmd, _
vbNullString, 0, 0&)
'// Save the recorded sound
ExecCmd = mciSendString(strSaveCmd & strSaveAs, vbNullString, 0, 0&)
'// Now close the Handle
ExecCmd = mciSendString(strCloseCmd, vbNullString, 0, 0&)
'// Tell the user it has finsihed
MsgBox "Finished recording", vbInformation
End Sub
Sub PlayBack()
WAVPlay strSaveAs
End Sub
Sub PlayBackLoop()
WAVLoop strSaveAs
End Sub
Sub PlayBackStop()
'// If your going o play a Loop then you need to STOP IT!
Call WAVPlay(vbNullString)
End Sub
Sub WAVLoop(File As String)
Dim SoundName As String
Dim wFlags As Long
Dim x As Long
SoundName = File
wFlags = SND_ASYNC Or SND_LOOP
x = sndPlaySound(SoundName, wFlags)
If x = 0 Then MsgBox "Can't play " & File
End Sub
Sub WAVPlay(File As String)
Dim SoundName As String
Dim wFlags As Long
Dim x As Long
SoundName = File
wFlags = SND_ASYNC Or SND_NODEFAULT
x = sndPlaySound(SoundName, wFlags)
If x = 0 Then MsgBox "Can't play " & File
End Sub
Highlight current cell locations Row & Column:
What it does:
This code will highlight the current row and column, up to the cell pointer in a light yellow color.
OK you have probably seen similar code, but this code is a little quicker.
As you scroll to a new cell, the highlights move with the cell pointer.
If the cell pointer moves to a cell that is already yellow, the highlights change color.
(See image below - from Mrexcel.com)
To get the Colour banding code see here:
![Goto Guest book sign in page [Home]](files/guestbk.gif)
Can Do
Highlight cell location alternative:
If you require a highlighter that DOES NOT use conditional formating ie. it preserves all your colours and conditional formating AND also allows you to Copy, Paste and Undo/Redo then try this amended code.
Code was amended from code @ MrExcel by Nate Oliver for Aldo.
Aldo also suggested a work around for deleting of the activecell.
Thanks guys!!
See code for comments.
Or, see below for copy code
Note:
There are two drawbacks to this method.
- First, as mentioned above, it is not appropriate if you already have conditional formats.
- Second, the code tends to clear the clipboard, so it becomes virtually impossible to copy and paste while this code is running.
- Code has been amended - thanks to Juan Pablo G. MrExcel.com Consulting. This amendment takes into consideration the international issues with some Key words in some functions not been recognised due to language eg. Conditional formating doesn't recognise TRUE in Spanish.
