Tuesday, July 29, 2008

Identify Objects that are linked to Source file using Excel VBA

Extract all Linked Objects in Excel Spreadsheet using VBA

At times when you send out some document, you should be careful of the external links that the document contains. The following code might help you:

Sub Extract_Linked_Objects()

Dim oWS As Worksheet ' Worksheet Object

Dim oOLE As OLEObject ' OLE Object

On Error GoTo Err_OLE

Set oWS = ActiveSheet

If oWS.OLEObjects.Count = 0 Then Exit Sub

For Each oOLE In oWS.OLEObjects

If oOLE.OLEType = xlOLELink Then

MsgBox oOLE.SourceName

End If

Next

Finally:

If Not oOLE Is Nothing Then Set oOLE = Nothing

If Not oWS Is Nothing Then Set oWS = Nothing

Err_OLE:

If Err <> 0 Then

Err.Clear

GoTo Finally

End If

End Sub





Embed Existing Word File to Spreadsheet using Excel VBA

Insert Existing File (Word Document) to Spreadsheet using VBA


Sub Insert_File_To_sheet()

Dim oWS As Worksheet ' Worksheet Object

Dim oOLEWd As OLEObject ' OLE Word Object

Dim oWD As Document ' Word Document Object (Use Microsoft Word Reference)

Set oWS = ActiveSheet

' embed Word Document

Set oOLEWd = oWS.OLEObjects.Add(Filename:="C:\VBADUD\Chapter 1.doc")

oOLEWd.Name = "EmbeddedWordDoc"

oOLEWd.Width = 400

oOLEWd.Height = 400

oOLEWd.Top = 30

' Assign the OLE Object to Word Object

Set oWD = oOLEWd.Object

oWD.Paragraphs.Add

oWD.Paragraphs(oWD.Paragraphs.Count).Range.InsertAfter "This is a sample embedded word document"

oOLEWd.Activate

End Sub

If you want to embed other document like PDF etc, you can do the same by

ActiveSheet.OLEObjects.Add Filename:= "C:\VBADUD\Sample_CH03.pdf", Link:=False, DisplayAsIcon:= False

Display embedded document as Icon

If you want to display the embedded document as an Icon set DisplayAsIcon property to True

See also:

Manipulate ActiveX TextBoxes in a Word Document using VBA

Embed Word Document to Excel Sheet using Excel VBA

Linking Text Box to Excel Range using VBA

Creating a Command Button on Sheet using Excel VBA

Get the Height & Width of Shapes / Figures in Word Document (Word VBA)

Embed Word Document to Excel Sheet using Excel VBA

Programming OLEOBjects in VBA to embed Word Document

Sub Embed_WordDocument_To_sheet()

Dim oWS As Worksheet ' Worksheet Object

Dim oOLEWd As OLEObject ' OLE Word Object

Dim oWD As Document ' Word Document Object (Use Microsoft Word Reference)

Set oWS = ActiveSheet

' embed Word Document

Set oOLEWd = oWS.OLEObjects.Add("Word.Document")

oOLEWd.Name = "EmbeddedWordDoc"

oOLEWd.Width = 400

oOLEWd.Height = 400

oOLEWd.Top = 30

' Assign the OLE Object to Word Object

Set oWD = oOLEWd.Object

oWD.Paragraphs.Add

oWD.Paragraphs(oWD.Paragraphs.Count).Range.InsertAfter "This is a sample embedded word document"

oOLEWd.Activate

End Sub







Add Words to AutoCorrect Entries

AutoCorrect feature is used to correct typos and misspelled words (dont to don’t), as well as to insert symbols ((c) as ©) and other pieces of text. AutoCorrect is set up by default with a list of typical misspellings and symbols. If you want to add more entries, you can do that by following

Office Button - -> Word Options - -> Proofing Tab - - >Autocorrect Options




Add the mistyped word and the replacement in Replace Box -- >Add







Barak Obama is the democratic presidential candidate will become Barack Obama is the democratic presidential candidate once you type.

The same can be achieved through Word VBA / Excel VBA

Excel VBA Code:

Sub Add_AutoCorrect_Entry_XL()

On Error GoTo Err_Label

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

Application.AutoCorrect.AddReplacement "VBADUD Plc", "VBADUD Inc"

Application.AutoCorrect.AddReplacement "Barak Obama", "Barack Obama"

Err_Label:

If Err <> 0 Then

MsgBox(Err.Description)

Err.Clear

End If

End Sub

Word VBA Code:

Sub Add_AutoCorrect_Entry()

On Error GoTo Err_Label

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

Application.AutoCorrect.Entries.Add "VBADUD Plc", "VBADUD Inc"

Application.AutoCorrect.Entries.Add "Barak Obama", "Barack Obama"

Err_Label:

If Err <> 0 Then

MsgBox(Err.Description)

Err.Clear

End If

End Sub

Linking Text Box to Excel Range using VBA

Linking Text Box to Excel Range (Excel 2007)


Here are the steps

1. Insert Text Box from Developer --> Insert



2. Set the LinkedCell of the textbox from Properties window



3. Text Typed in Embedded Text Box will be reflected on sheet range



This way you can create a simple data entry form

Here is the way to do the same using VBA code

Sub Insert_TextBOX_OLE()

Dim oOLETB As OLEObject ' Ole Object Text Box

Dim oWS As Worksheet ' Work sheet

On Error GoTo Err_OLE

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

oWS = ActiveSheet

oOLETB = oWS.OLEObjects.Add("Forms.TextBox.1")

oOLETB.Name = "MySampleTextBox"

oOLETB.Height = 20

oOLETB.Width = 100

oOLETB.Top = Range("D2").Top

oOLETB.Left = Range("D2").Left

oOLETB.LinkedCell = "$I$2"

oOLETB.Object.Text = "VBADUD Sample"

' ---------------------------------------------

' Destroy Object

' ---------------------------------------------

Finally:

If Not oOLETB Is Nothing Then oOLETB = Nothing

If Not oWS Is Nothing Then oWS = Nothing

' ---------------------------------------------

' Error Handling

' ---------------------------------------------

Err_OLE:

If Err <> 0 Then

MsgBox(Err.Description)

Err.Clear()

GoTo Finally

End If

End Sub


Sunday, July 20, 2008

Check for existence of Filter using Excel VBA

Check if Range is Filtered / Check if Sheet has AutoFilter using Excel VBA

Checks for filter can be done at two levels

1. If Range/Sheet has AutoFilder

2. If Filter has been applied on any column

Sub Check_AutoFilter_IsPresent()

Dim oWS As Worksheet ' Worksheet Object

On Error GoTo Disp_Error

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

oWS = ActiveSheet

If Not oWS.AutoFilter Is Nothing Then

If oWS.FilterMode = True Then

MsgBox("Auto Filter On: Filter Mode On")

Else

MsgBox("Auto Filter On: Filter Mode Off")

End If

Else

MsgBox("Auto Filter Off")

End If

If Not oWS Is Nothing Then oWS = Nothing

' --------------------

' Error Handling

' --------------------

Disp_Error:

If Err <> 0 Then

MsgBox(Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples")

Resume Next

End If

End Sub

See also:

Create AutoFilter with Multiple Criteria using Excel VBA

AutoFilter using Excel VBA

Check for existence of Filter using Excel VBA

Excel Filter Show All using VBA

Retrieve / Get First Row of Excel AutoFilter using VBA

Excel Filter Show All using VBA

Show All Information from a Filtered Range

Sub Show_All_In_AutoFilter()

Dim oWS As Worksheet ' Worksheet Object

On Error GoTo Disp_Error

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

oWS = ActiveSheet

oWS.ShowAllData()

If Not oWS Is Nothing Then oWS = Nothing

' --------------------

' Error Handling

' --------------------

Disp_Error:

If Err <> 0 Then

MsgBox(Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples")

Resume Next

End If

End Sub

Set AutoFilter to all using Excel VBA

See also:

Create AutoFilter with Multiple Criteria using Excel VBA

AutoFilter using Excel VBA

Check for existence of Filter using Excel VBA

Excel Filter Show All using VBA

Retrieve / Get First Row of Excel AutoFilter using VBA

Format ListColumns using VBA

Format ListObject Columns Programmatically using Excel VBA

Sub Format_ListColumns()

Dim oWS As Worksheet ' Worksheet Object

Dim oRange As Range ' Range Object - Contains Represents the List of Items that need to be made unique

Dim oLst As ListObject ' List Object

Dim oLC As ListColumn ' List Column Object

On Error GoTo Disp_Error

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

oWS = ActiveSheet

If oWS.ListObjects.Count = 0 Then Exit Sub

oLst = oWS.ListObjects(1)

oLC = oLst.ListColumns("Price")

oLC.DataBodyRange.NumberFormat = "0.00"

If Not oLC Is Nothing Then oLC = Nothing

If Not oLst Is Nothing Then oLst = Nothing

If Not oWS Is Nothing Then oWS = Nothing

' --------------------

' Error Handling

' --------------------

Disp_Error:

If Err <> 0 Then

MsgBox(Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples")

Resume Next

End If

End Sub



Excel Range Before Formatting
Excel Range After Formatting

Add Total Row to Excel Table using VBA

Add Total Row to Existing List Object using Excel VBA

Sub Add_TotalRow_2_ExistingTable()

Dim oWS As Worksheet ' Worksheet Object

Dim oRange As Range ' Range Object - Contains Represents the List of Items that need to be made unique

Dim oLst As ListObject ' List Object

Dim oLC As ListColumn ' List Column Object

On Error GoTo Disp_Error

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

oWS = ActiveSheet

If oWS.ListObjects.Count = 0 Then Exit Sub

oLst = oWS.ListObjects(1)

oLst.ShowTotals = True

' Change/Set the formatting of the Totals Row

oLst.TotalsRowRange.Font.Bold = True

oLst.TotalsRowRange.Font.Color = vbRed

If Not oLC Is Nothing Then oLC = Nothing

If Not oLst Is Nothing Then oLst = Nothing

If Not oWS Is Nothing Then oWS = Nothing

' --------------------

' Error Handling

' --------------------

Disp_Error:

If Err <> 0 Then

MsgBox(Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples")

Resume Next

End If

End Sub

ShowTotals method is used for appending a total row to the Excel List. TotalsRowRange is used for formatting Excel data


Related Posts Plugin for WordPress, Blogger...
Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.