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
Welcome to VBA Tips & Tricks. All VBA related information will be posted on this blog. Of late, VBA has been disregarded by many software professionals for .Net, c# and other technologies. This blog will also post articles related to them too Happy reading
Thursday, March 8, 2012
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
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
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
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
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
Subscribe to:
Posts (Atom)