Some Useful Macro Procedure-2

Some Useful Macro Procedure-2

Getting a list of fonts

If you need to get a list of all installed fonts, you’ll find that Excel doesn’t provide a direct way to retrieve that information. The technique described here takes advantage of the fact that (for compatibility purposes) Excel 2007 still supports the old CommandBar properties and methods. These properties and methods were used in pre-Excel 2007 versions to work with toolbars and menus. The FontsList macro displays a list of the installed fonts in column A of the active worksheet. It creates a temporary toolbar (a CommandBar object), adds the Font control, and reads the font names from that control. The temporary toolbar is then deleted.

Sub FontsLists()

Dim FontList As CommandBarControl

Dim TempBar As CommandBar

Dim i As Long

' Create temporary CommandBar

Set TempBar = Application.CommandBars.Add

Set FontList = TempBar.Controls.Add(ID:=1728)

' Put the fonts into column A

Range("A:A").ClearContents

For i = 0 To FontList.ListCount - 1

Cells(i + 1, 1) = FontList.List(i + 1)

Cells(i + 1, 1).Font.Name = FontList.List(i + 1)

Next i

' Delete temporary CommandBar

TempBar.Delete

End Sub

Retrieving a value from a closed workbook

This procedure reads 1,200 values (100 rows and 12 columns) from a closed file and then places the values into the active worksheet.

Private Function GetValue(path, file, sheet, ref)

‘ Retrieves a value from a closed workbook

Dim arg As String

‘ Make sure the file exists

If Right(path, 1) <> “\” Then path = path & “\”

If Dir(path & file) = “” Then

GetValue = “File Not Found”

Exit Function

End If

‘ Create the argument

arg = “’” & path & “[“ & file & “]” & sheet & “’!” & _

Range(ref).Range(“A1”).Address(, , xlR1C1)

‘ Execute an XLM macro

GetValue = ExecuteExcel4Macro(arg)

End Function

Sub GetFileValue()

Dim p As String, f As String

Dim s As String, a As String

Dim r As Long, c As Long

p = “c:\Files\”

f = “Activity.xlsx”

s = “Sheet1”

Application.ScreenUpdating = False

For r = 1 To 100

For c = 1 To 12

a = Cells(r, c).Address

Cells(r, c) = GetValue(p, f, s, a)

Next c

Next r

End Sub

In Next Section We will Talk About Builtin User Form in Excel