1)

2)

3)

4)

5)

6)

7)

Excel
Ivan F Moala
Tell a friend about this page
Google
This page was last updated on: April 25, 2006
You are visitor number:
Can Do







































































Open ANY Program






Change Worksheet Tab Colour:

The following code is just for show, have a look below;



























If someone tells you you cannot colour Excel97 / 2000 Tabs (Version < Xp > 95) then show them this. Note it is not for practical use, just an example of using the system colors.

Get example workbook Here
They said it couldn't be done
                                                                   









In the Userform Code;

Private Sub UserForm_Click()
  Application.CommandBars.FindControl(ID:=927).Execute
End Sub







Method 2: By Colo

This method was supplied by my good friend Colo. Thankyou Colo






Option Explicit

'---Standard module
Sub Test()
  UserForm1.Show
End Sub

Option Explicit
'---Userform1 module
Private Sub CommandButton1_Click()
' If Error message is shown, delete or comment out of following.
  CommandButton1.TakeFocusOnClick = False
  ActiveCell.Activate
  ActiveCell.Value = "What?"
End Sub

'---Userform1 module
Private Sub UserForm_Activate()
  With Application
   .SendKeys "{esc}", True
   .GetOpenFilename
   .SendKeys "{esc}", True
  End With
End Sub










Visits here
                                                          Phoning using Excel:


You can use your micorphone and the Dialer to make a call from within Excel:



Option Explicit


Public Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" ( _
  ByVal Dest As String, _
  ByVal AppName As String, _
  ByVal CalledParty As String, _
  ByVal Comment As String) As Long

Sub PhoneCall()
Dim strNumber As String, strName As String
Dim lRetVal As Long

strNumber = "09 2751179"
strName = "Work"

'// Make a voice call using the default call manager application
lRetVal = tapiRequestMakeCall(Trim(strNumber), vbNull, Trim(strName), "")

'// Let the call manager application handle the errors!
End Sub






'// Routine goes in the ThisWorkBook Object

'// Start

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ChangeTab_Colour
End Sub

'// End


'// Routine goes into a Standard Module

Option Explicit

'// Routine to change the colour of the Spreadsheet Tabs


'// API's for System Colours
Private Declare Function GetSysColor Lib "user32" ( _
ByVal nIndex As Long) As Long

Private Declare Function SetSysColors Lib "user32" ( _
ByVal nChanges As Long, _
lpSysColor As Long, _
lpColorValues As Long) As Long

'// Define Colour Constant
Private Const COLOR_WINDOW = 5

Sub ChangeTab_Colour()
Dim Kolor As Long
Dim CurKolor As Long
Dim R As Integer, G As Integer, B As Integer

'// Initialize random-number generator.
Randomize
'// Generate random value between 0 and 255.
R = Int(255 * Rnd)
G = Int(255 * Rnd)
B = Int(255 * Rnd)

'// Try these if you want Basic Colours
'// ===============================================
'// Black 0 0 0 || Blue 0 0 255
'// Green 0 255 0 || Cyan 0 255 255
'// Red 255 0 0 || Magenta 255 0 255
'// Yellow 255 255 0 || White 255 255 255
'// ===============================================
CurKolor = GetSysColor(COLOR_WINDOW)

With Application
.ScreenUpdating = False
'// color it Randomly
Kolor = SetSysColors(1, COLOR_WINDOW, RGB(R, G, B))
ShSet
.ScreenUpdating = True
MsgBox "Tab colour has changed!", vbInformation + vbSystemModal, _
"Tab Colour Hack "
.ScreenUpdating = False
ShReset
'// Restore to Default
Kolor = SetSysColors(1, COLOR_WINDOW, CurKolor)
.ScreenUpdating = True
End With

End Sub

Sub ShSet()
Dim x As Double

Cells.Select
With Selection
.Interior.ColorIndex = 2
.Interior.Pattern = xlSolid
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
For x = 7 To 12
With Selection.Borders(x)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15
End With
Next
[A1].Select
End Sub

Sub ShReset()
Cells.Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.ColorIndex = xlNone
End With
[A1].Select
End Sub
Copyright © 2002. XcelFiles. All Rights Reserved. Ivan F Moala
Option Explicit


'// Set up the API's
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 FindWindowEx Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long

'// Define Scrn Constants
Private Const SM_CXSCREEN = 0

'// Define ComboBox Constants
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_GETDROPPEDWIDTH = &H15F

'// Define Message
Private Const msg As String = "Could NOT set the NameBox width!"

'// Define some Class Constants
Private Const strDropBtnClass As String = "ComboBox" 'Name Box Class
Private Const strXLClass As String = "XLMAIN" 'Main Xl Window Class
Private Const strXLChildClass As String = "EXCEL;" 'FormulaBar Class

Public Sub ReSizeNameBoxWidth()
'//////////////////////////////////////////////////////
'// Resize the Excel Name Box [ComboBox dropdown width]
'// Developement Enviroment:
'// : Excel2000 / Win 98
'// Created by Ivan F Moala 15th September 2002
'// Tests:
'// Tested Excel XP and XL2000 on WinMe
'// By Juan Pablo G.
'// MrExcel.com Consulting
'// Tom Utis
'// Tested XL 2002 on Windows 2000 SP-3
'// Windows Me - Swedish
'// Windows 2000 - Swedish SP-3
'// Windows XP - Swedish
'// Excel -versions:
'// XL 97 SR2b - Swedish
'// XL 2000 SP-1 - Swedish
'// XL 2002 SP-2 - English / Swedish.
'// Testresult: No error reported
'// Wishlist:
'// That the namebox lenght adjust automatically to the longest used named.
'// By XL Dennis
'//////////////////////////////////////////////////////

Dim hwndXl As Long '// Child window that contains combobox
Dim xlMain As Long '// Xl Window handle
Dim hwndcbo As Long '// Handle of Name Box dropdown
Dim lSetWidth As Long '// setting for new width
Dim lScrnWidth As Long '// Screen Width
Dim Ret As Long '// Return Function success variable

'// Get Xls handle ie. Main Wnd
xlMain = FindWindowA(strXLClass, vbNullString)

'// Get Child Wnd
hwndXl = FindWindowEx(xlMain, 0, strXLChildClass, vbNullString)

'// NOW Get Handle of the Name Box
hwndcbo = FindWindowEx(hwndXl, 0, strDropBtnClass, vbNullString)

lScrnWidth = GetSystemMetrics(SM_CXSCREEN)
'// Currently set @ 1/2 Screen width
'// Change as required
'// Yes I know I should probably set it to the Max Width of the Text!
'// But thats another prgming effort!
lSetWidth = lScrnWidth / 2

Ret = SendMessage(hwndcbo, CB_SETDROPPEDWIDTH, lSetWidth, 0)
If Ret = 0 Then MsgBox msg, vbInformation

End Sub


Option Explicit


Private Declare Function HtmlHelp Lib "hhctrl.ocx" _
Alias "HtmlHelpA" ( _
ByVal hwndCaller As Long, _
ByVal pszFile As String, _
ByVal uCommand As Long, _
ByVal dwData As Long) As Long

'// Some constants to use
Const HH_DISPLAY_TOPIC = &H0
Const HH_SET_WIN_TYPE = &H4
Const HH_GET_WIN_TYPE = &H5
Const HH_GET_WIN_HANDLE = &H6
Const HH_DISPLAY_TEXT_POPUP = &HE
'// Display string resource ID or text in a pop-up window.
Const HH_HELP_CONTEXT = &HF
'// Display mapped numeric value in dwData.
Const HH_TP_HELP_CONTEXTMENU = &H10
'// Text pop-up help, similar to WinHelp's HELP_CONTEXTMENU.
Const HH_TP_HELP_WM_HELP = &H11
'// Text pop-up help, similar to WinHelp's HELP_WM_HELP.
Const HH_CLOSE_ALL = &H12

Sub OpenHelp()
Dim hwndHelp As Long
'// The returned value is the window handle of the created help window.
hwndHelp = HtmlHelp(0, "C:\WINDOWS\HELP\msoe.chm", HH_DISPLAY_TOPIC, 0)
If hwndHelp = 0 Then MsgBox "Can't load"
End Sub

Sub CloseHelp()
HtmlHelp 0, "", HH_CLOSE_ALL, 0
End Sub

Sub Tester()
'// Display Alerts DOES NOT Work
With Application
.DisplayAlerts = False
ActiveWorkbook.FollowHyperlink _
Address:="C:\WINDOWS\HELP\msoe.chm", NewWindow:=True
.DisplayAlerts = True
End With
End Sub
Goto Guest book sign in page [Home]