Thursday, March 8, 2012

A simple demonstration of the Selection.Information property

Sub SelectionInformation()
Debug.Print "Selection starts at column: " & _
Selection.Information(wdFirstCharacterColumnNumber)

Debug.Print "Selection starts at line: " & _
Selection.Information(wdFirstCharacterLineNumber)

Debug.Print "The selection starts on page " & _
Selection.Information(wdActiveEndPageNumber) _
& ". There are " & _
Selection.Information(wdNumberOfPagesInDocument) & _
" page(s) in the document."
End Sub

This listing demonstrates basic data retrieval from an Access database.

Sub DatabaseExample()
Dim rst As ADODB.Recordset
Dim sConnection As String
Dim sSQL As String
Dim rg As Range

On Error GoTo ErrHandler

' This is the range that will receive the data.

Set rg = ThisWorkbook.Worksheets(1).Range("a1")

' The database connection string. Double-check the path
' to the Northwind database on your computer.

sConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Program Files\Microsoft Office\" & _
"OFFICE11\SAMPLES\northwind.mdb"

' The query to execute

sSQL = "SELECT LastName, FirstName, Title FROM employees"

' Create & Open the recordset

Set rst = New ADODB.Recordset
rst.Open sSQL, sConnection

' Copy to the range

rg.CopyFromRecordset rst
rg.CurrentRegion.Columns.AutoFit

' Close the recordset when you're done with it.

rst.Close

ExitPoint:
Set rst = Nothing
Set rg = Nothing
Exit Sub

ErrHandler:
MsgBox "Sorry, an error occured. " & Err.Description, vbOKOnly

' resume at the ExitPoint label to clean up object variables
Resume ExitPoint
End Sub

How to created hyperlinks in VBA:-

Sub Create_HyperLinks()

Dim i1 As Integer
Dim sA, sB As String

For i1 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
If LenB(Trim$(Cells(i1, 3).Value)) <> 0 Then
sA = Trim$(Cells(i1, 1).Value)
sB = Trim$(Cells(i1, 2).Value)
sA = "Compared_" & sA & "_" & sB & ".xls"
Sheets(1).Range("C" & i1).Hyperlinks.Add Cells(i1, 3), "CompareReports\" & sA
End If
Next i1

End Sub

How to convert text to Comments using VBA

Sub Convert_Text_To_Comments()

Dim sText As String ' Comment String
Dim i1 As Long ' Counter
Dim sUser As String ' User Name

sUser = Application.UserName

For i1 = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

sText = ActiveSheet.Cells(i1, 5).Value

'Deletes Existing Comments
Cells(i1, 3).ClearComments

' Creates Comment
Cells(i1, 3).AddComment
Cells(i1, 3).Comment.Text Text:=sUser & Chr(10) & sText

Next i1

End Sub

How to Identify and Tag Numbered Lists using VBA

Sub Tag_Lists()

Dim oBL As ListFormat
Dim oList As List
Dim oLI

For Each oList In ActiveDocument.Lists
If oList.Range.ListFormat.ListType = WdListType.wdListBullet Then
For Each oLI In oList.ListParagraphs
oLI.Range.InsertBefore ""
oLI.Range.InsertAfter ""
Next oLI
oList.Range.InsertBefore ""
oList.Range.InsertAfter ""
End If
Next oList

End Sub