Archive for September, 2008
September 25, 2008 at 12:27
· Filed under VBA Examples
Original source: www.nandeshwar.info
-Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
If you want to convert the text to uppercase, use the following code.
HOW SHOULD I USE THE FOLLOWING CODE
Sub Conv2UCase()
On Error GoTo Conv2UCase_Error
Dim vDataArr As Variant
Dim lUpperBndRow As Long, lUpperBndCol As Long
Dim lRow As Long, lCol As Long
'store selected values in an array
vDataArr = Selection
'get the upper bound of rows
lUpperBndRow = UBound(vDataArr, 1)
'get the upper bound of cols
lUpperBndCol = UBound(vDataArr, 2)
'Start a loop to go through all the elements of the array
For lRow = 1 To lUpperBndRow
For lCol = 1 To lUpperBndCol
'Check if the value is text, if not don't convert
If WorksheetFunction.IsText(vDataArr(lRow, lCol)) Then
'Convert values to upper case
vDataArr(lRow, lCol) = UCase(vDataArr(lRow, lCol))
End If
Next lCol
Next lRow
'Return the converted values to the range
Selection = vDataArr
Exit Sub
Conv2UCase_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub:Conv2UCase"
End Sub
Permalink
September 16, 2008 at 12:42
· Filed under VBA Examples
-Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
- The macro will add a sheet with the name Master to your workbook and will copy the cells from every sheet in your workbook in this worksheet.
- The first macro does a normal copy and the second macro copy the Values.
- The macro’s subs use the functions below, the macro’s won’t work without the functions.
HOW SHOULD I USE THE FOLLOWING CODE
Sub CopyRange()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CopyRangeValues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
With sh.Range("A1:C5")
DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function
|
Permalink
September 11, 2008 at 18:11
· Filed under VBA Examples
Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
Since long time I was curious to know if we can manipulate drawing objects and flowchart shapes through vba. I knew that it is possible but never tried as I thought it would be quite complex. But I was wrong. It is simple enough to draw shapes and connectors in seconds while it takes a long time to arrange different shapes manually. I tried something and i am sure it will help someone while trying to draw flowchart or processchart.
CLICK HERE to download FlowChart Helper.
If you think I can be of some help, contact me at selvavinaygam (at) G m a i l (dot) com.
Permalink
September 7, 2008 at 20:38
· Filed under Downloads, Tutorials
Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
Table of Contents
Chapter 1 – An Overview of ActiveX
Chapter 2 – OLE Components
Chapter 3 – Creating COM Objects
Chapter 4 – Creating OLE Automation Server
Chapter 5 – OLE Controls
Chapter 6 – Creating OLE Control Containers
Chapter 7 – Microsoft Internet Explorer 3.0 and Its Scripting Object Model
Chapter 8 – VBScript
Chapter 9 – JavaScript
Chapter 10 – Using Microsoft FrontPage
Chapter 11 – Using ActiveX Control Pad
Chapter 12 – Advanced Web Page Creation
Chapter 13 – Windows CGI Scripting
Chapter 14 – ISAPI Server Applications
Chapter 15 – ISAPI Filter Objects
Chapter 16 – Internet Database Connector
Chapter 17 – Microsoft ActiveVRML
Chapter 18 – OLE Document Objects
Chapter 19 – Hyperlink Navigation
Appendix A – Internet Explorer 3.0
Appendix B – Microsoft Internet Explorer Logo Program
Appendix C – Microsoft Visual C++ 4.1 and 4.2
Appendix D – Visual J++
Appendix E – ActiveX Template Library
Appendix F – HTML Enhancement by Internet Explorer 3.0
Permalink
September 1, 2008 at 19:24
· Filed under Automation, VBA Examples
- Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
| The following code illustrates how one can use visual basic for automated file download when the code actually initializes the internetexplorer and navigates the path, and it saves at the location suggested by the user the file that is to be downloaded… Please be advised this code is not well tested and might not be perfect in all scenario.
HOW SHOULD I USE THE FOLLOWING CODE
|
Option Explicit
Dim OBJIE As InternetExplorer
Dim myurl As String
Dim myExcelFile As String
'____________________________________________________________
Sub DownLoad_File()
' --------- Initialize strings like name of the file & -
' url to navigate --------------------------------------
myExcelFile = FileNameWithPath
myurl = "http://www.sockofiles.350.com/" & _
"Form=_With=_no=_title=_bar.xls"
' ---------- Open internetexplorer and navigate --------
Set OBJIE = New InternetExplorer
With OBJIE
.Navigate myurl
.AddressBar = 0
.FullScreen = False
.Height = 300
.Width = 400
.Top = 0
.Left = 0
.Toolbar = 0
.MenuBar = 0
.Resizable = 0
.StatusBar = 0
.Visible = True
End With
' --------Wait till IE is free -------------------------
Do Until OBJIE.ReadyState
DoEvents
Loop
' --------Pass on keys to download and save ------------
Application.Wait Now() + TimeValue("00:0:03")
SendKeys ("%s")
Application.Wait Now() + TimeValue("00:0:03")
SendKeys (myExcelFile)
Application.Wait Now() + TimeValue("00:0:03")
SendKeys ("%s")
Application.Wait Now() + TimeValue("00:0:03")
OBJIE.Quit
MsgBox "DONE"
End Sub
'____________________________________________________________
Function FileNameWithPath() As String
FileNameWithPath = _
InputBox("Give the complete name of the " & _
"file that you want to save including path")
End Function
|
Permalink
September 1, 2008 at 16:46
· Filed under Userforms, VBA Advanced, VBA Examples
- Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
|
Normally when a userform is initiated you would see it with a blue title bar by default everytime. But if you want to use the userform as a title form, then one would be interested in removing the titlebar. One more userful Tip I came across at Colo’s Excel Junk Room – Masaru Kaji. The following code shows userform with no titlebar and closes after few seconds.
|
HOW SHOULD I USE THE FOLLOWING CODE
Copy the following code in standard code module.
'///place these procedures on a standard module
Option Explicit
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
Public Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal hWnd As Long) As Long
Public Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'____________________________________________________________
Sub Form_Show()
'Hide Excel
Application.Visible = False
'To close a form automatically
Application.OnTime Now, "Form_Close"
UserForm1.Show
End Sub
'____________________________________________________________
Sub Form_Close()
'To close a form automatically
Dim datWaitTime As Date
datWaitTime = TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 3)
Application.Wait datWaitTime
Unload UserForm1
Application.Visible = True
End Sub
'____________________________________________________________
Sub HideTitleBar(frm As Object)
Dim lngWindow As Long
Dim lFrmHdl As Long
lFrmHdl = FindWindowA(vbNullString, frm.Caption)
lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
Call DrawMenuBar(lFrmHdl)
End Sub
'____________________________________________________________
|
Copy following code into the userform code.
'//Place these procedures on the UserForm1 module
Option Explicit
Private Sub UserForm_Initialize()
HideTitleBar Me
End Sub
'____________________________________________________________
Private Sub UserForm_Click()
'Close this userform
Unload Me
End Sub
'____________________________________________________________
|
To download Example file CLICK HERE
Permalink
September 1, 2008 at 16:09
· Filed under Userforms, VBA Advanced, VBA Examples
-Selva V Pasupathy, HSBC Global Resourcing, Hyderabad 1
Original source: Colo’s Excel Junk Room – Masaru Kaji
|
Last week I was working on an excel application where I wanted several images of the userform at various stages so that I can prepare SOP for documentation. It was difficult for me because on my system Print Screen button was not working and I did not know how to activate that. While browsing hte net and going through colo;s junk room, I came across the code below which saves a userform as an image when you double click on the userform. With API, this code pastes an image of the form into a worksheet of the new workbook, then save it as a HTML file. When the Excel workbook is saved as a html file, all image files will be placed in the different folder.
HOW SHOULD I USE THE FOLLOWING CODE
Place the following code in a userform module.
|
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const VK_LMENU = &HA4
Private Const VK_SNAPSHOT = &H2C
Private Const VK_CONTROL = &H11
Private Const VK_V = &H56
Private Const VK_0x79 = &H79
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
'__________________________________________________
Private Sub UserForm_DblClick _
(ByVal Cancel As MSForms.ReturnBoolean)
Dim sAppOs As String
Dim wks As Worksheet
'get oparating system
sAppOs = Application.OperatingSystem
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Mid(sAppOs, 18, 2) = "NT" Then
' WinNT,Windows2000,WindowsXP - Using Win32API
Call keybd_event(VK_LMENU, VK_V, _
KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79, _
KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_LMENU, VK_V, _
KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79, _
KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0)
Else
' Windows95,Windows98,WindowsME
Call keybd_event(VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End If
DoEvents
Unload Me
Set wks = Workbooks.Add.Sheets(1)
Application.Goto wks.Range("A1")
ActiveSheet.Paste
wks.SaveAs Filename:="C:\myfile.htm", FileFormat:=xlHtml
wks.Parent.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Have a look at C:\myfile.files folder."
End Sub
'__________________________________________________
|
To download example file CLICK HERE
Permalink
