To stop this message set the Grammar checked to be true
Sub Set_Spell_Grammar()
ActiveDocument.GrammarChecked = True
ActiveDocument.SpellingChecked = True
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
Conditional Formatting using Excel VBA
Here is a small snippet for FormatConditions.
Sub Format_Condition_Example()
Dim oFc As FormatCondition
Dim oRange As Range
Set oRange = Range("B2:B5")
Set oFc = oRange.FormatConditions.Add(xlCellValue, xlLess, "0.5")
oFc.Interior.ColorIndex = 3
Set oFc = oRange.FormatConditions.Add(xlCellValue, xlBetween, "0.5", "0.80")
oFc.Interior.ColorIndex = 6
Set oFc = oRange.FormatConditions.Add(xlCellValue, xlGreater, "0.80")
oFc.Interior.ColorIndex = 4
End Sub
Excel VBA - Hide Pivot Table Fields List
If you are developing some pivot table as part of the report and feel the Pivot Fields list at the right corner is bit distracting, you can turn it off as shown below:
Sub Hide_PivotTable_Fields()
ActiveWorkbook.ShowPivotTableFieldList = False 'Dont Show the Pivot Table List
End Sub
Excel Range to Word Template using VBA
Most often we maintain list of contacts in Excel workbook and it needs to be transferred to Word document (made from some template). Here is a simple snippet that can help:
The code is used to copy the content from Excel range shown below to a Word document:
Name | ContactNo | Address | Email |
Christina | 516 418 1234 | Cincinatti | |
Girish Kutty | 516 418 6752 | Cincinatti | |
Ravichand Koneru | 777 213 213 | Boston |
Sub CopY_Data_To_Word()
Dim oWA As Word.Application
Dim oWD As Word.Document
Set oWA = New Word.Application
Set oWD = oWA.Documents.Add("C:\Users\comp\Documents\Doc2.dot") ' Replace with your template here
For i1 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
oWD.Bookmarks("Name").Range.Text = Cells(i1, 1)
oWD.Bookmarks("ContactNo").Range.Text = Cells(i1, 2)
oWD.Bookmarks("Address").Range.Text = Cells(i1, 3)
oWD.Bookmarks("Email").Range.Text = Cells(i1, 4)
'Code for saving the document
Next i1
' Releasing objects etc
End Sub
Bookmarks are added to the Word template and whenever a new document is created from the template, the document has those bookmarks.
The code above places the information from the Excel sheet to the specific Bookmark ranges
How to configure Pivot Table source data externally through VBA
A Pivot Table is linked to a particular source data. If for some reasons, you need that to be configured by users the following code will give some hint:
Sub Change_Pivot_TableDataSource()
Dim oPT As PivotTable
Dim oPC As PivotCache
Dim ORange As Range
Set oPT = ActiveSheet.PivotTables(1)
Set oPC = oPT.PivotCache
Set ORange = Application.InputBox(Prompt:="Select the New DataRange", Type:=8)
oPC.SourceData = "Sheet1!" & Application.ConvertFormula(ORange.Address, xlA1, xlR1C1)
oPT.RefreshTable
If Not oPT Is Nothing Then Set oPT = Nothing
If Not oPC Is Nothing Then Set oPC = Nothing
End Sub
The code gets the new data range through Input Box and modifies the SourceData of the Pivot Table. Change the Sheet name accordingly before you use the code.
Excel VBA Check Pivot Source
The following snippet could help in getting the source type of the Pivot Table
Sub CheckSourceConnection()
Dim pvtCache As PivotCache
Set pvtCache = Application.ActiveWorkbook.PivotCaches.Item(1)
On Error GoTo No_Connection
If pvtCache.SourceType = xlDatabase Then
MsgBox "The data source connection is: " & _
pvtCache.SourceData, vbInformation, "Pivot Table Source"
ElseIf pvtCache.SourceType = xlExternal Then
MsgBox "The data source connection is: " & _
pvtCache.SourceDataFile, vbInformation, "Pivot Table Source"
End If
Exit Sub
No_Connection:
MsgBox "Pivot Table source cannot be determined.", vbInformation, "Pivot Table Source"
End Sub
Create Popup Menu (Right Click menu) using VBA
Here is a simple snippet that will add a menu item to the popup menu and assign a macro to it
Public Const APP_SHORTNAME = "VBADUD_POPUP"
Sub Add_To_Popup_Menu()
Dim ctlNewMenu As CommandBarControl
Dim ctlNewGroup As CommandBarControl
Dim ctlNewItem As CommandBarControl
On Error GoTo Err_Trap
On Error Resume Next
Application.CommandBars("Cell").Controls(APP_SHORTNAME).Delete
On Error GoTo 0
Set ctlNewMenu = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup)
ctlNewMenu.Caption = APP_SHORTNAME
'--- Button - Load Raw Data ------------
Set ctlNewItem = ctlNewMenu.Controls.Add(Type:=msoControlButton)
ctlNewItem.Caption = "Process Data"
ctlNewItem.OnAction = "ProcessData"
Err_Trap:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
The above will create a new Group and add the “Process Data” control to it.
Convert Word to PDF using VBA
Word 2007 has a new method - Document.ExportAsFixedFormat, which saves the document as PDF or XPS format
The following code will save the current document as PDF in the same path
Sub Convert_2_PDF()
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
ActiveDocument.Path & "\" & ActiveDocument.Name & ".pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub
Here is the way to save the active chart in Excel 2007 to a JPG file. It is better to size the chart appropriately before exporting it as an image.
Sub Save_ChartAsImage()
Dim oCht As Chart
Set oCht = ActiveChart
On erRROR GoTo Err_Chart
oCht.Export Filename:="C:\PopularICON.jpg", Filtername:="JPG"
Err_Chart:
If Err <> 0 Then
Debug.Print Err.Description
Err.Clear
End If
End Sub
The code uses Export method to save the chart in graphics format
How to Install Analysis ToolPak in Excel 2007
In the Manage list, select Excel Add-ins, and then click Go.
In the Add-ins available list, select the Analysis ToolPak box, and then click OK.
If necessary, follow the instructions in the Setup program.
Sub Connect2SQLXpress() |
Dim oCon As ADODB.Connection |
Dim oRS As ADODB.Recordset |
Set oCon = New ADODB.Connection |
oCon.ConnectionString = "Driver={SQL Native Client};Server=.\SQLEXPRESS;Database=DB1; Trusted_Connection=yes;" |
oCon.Open |
Set oRS = New ADODB.Recordset |
oRS.ActiveConnection = oCon |
oRS.Source = "Select * From Table1" |
oRS.Open |
Range("A1").CopyFromRecordset oRS |
oRS.Close |
oCon.Close |
If Not oRS Is Nothing Then Set oRS = Nothing |
If Not oCon Is Nothing Then Set oCon = Nothing |
End Sub |
The following code snippet would be helpful to update an Access 2007 database table using VBA. The code uses
The sample uses a simple table which contains a name and a location field.
The code uses the SQL update query to update the database. The query is executed by the
Sub Simple_SQL_Update_Data()
Dim Cn As ADODB.Connection '* Connection String
Dim oCm As ADODB.Command '* Command Object
Dim sName As String
Dim sLocation As String
Dim iRecAffected As Integer
On Error GoTo ADO_ERROR
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\comp\Documents\SampleDB.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open
sName = "Krishna Vepakomma"
sLocation = "
Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
oCm.CommandText = "Update SampleTable Set Location ='" & sLocation & "' where UserName='" & sName & "'"
oCm.Execute iRecAffected
If iRecAffected = 0 Then
MsgBox "No records inserted"
End If
If Cn.State <> adStateClosed Then
Cn.Close
End If
Application.StatusBar = False
If Not oCm Is Nothing Then Set oCm = Nothing
If Not Cn Is Nothing Then Set Cn = Nothing
ADO_ERROR:
If Err <> 0 Then
Debug.Assert Err = 0
MsgBox Err.Description
Err.Clear
Resume Next
End If
End Sub
The following code snippet gives a hint on how to extract synonym list using Word VBA
Sub Retrieve_Word_Info()
Dim arSynonyms
Dim oSynInfo As SynonymInfo
Dim arSynList
Dim sWord As String
sWord = "call"
Set oSynInfo = Application.SynonymInfo(sWord)
If oSynInfo.Found = True Then
For i1 = 1 To oSynInfo.MeaningCount
arSynList = oSynInfo.SynonymList(i1)
For i2 = 1 To UBound(arSynList)
MsgBox oSynInfo.MeaningList(i1) & " := " & arSynList(i2)
Next
Next i1
End If
End Sub
How to get the free space available using VBA
The FreeDiskSpace property can be used to retrieve the free space information from Word VBA
Sub FreeDiskSpace_Current_Drive()
Dim sFreeSpace As String
sFreeSpace = System.FreeDiskSpace
sFreeSpace = Format(sFreeSpace, "0,000")
MsgBox "Free Space Available is " & sFreeSpace
End Sub