Friday, May 11, 2012

How to Save PowerPoint Presentation as PDF using VBA

How to Convert PowerPoint Presentation PPT to PDF using VBA

PDF is always the universal format for sending the files. With lot of versions of MS Office and other Office suites around .. it is better to circulate the Deck as a PDF

The following snippet converts the Presentation to a PDF and saves in the same folder of the PPT

ActivePresentation.ExportAsFixedFormat ActivePresentation.Path & "\" & ActivePresentation.Name & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint


Sunday, May 06, 2012

Excel VBA TimeStamp – Milliseconds using Excel VBA

How to Get Time in Milliseconds using Excel VBA
The following function uses Timer function to get the milliseconds and append it to the current time
Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "dd-MMM-yyyy HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function
Timer function returns a Single representing the number of seconds elapsed since midnight.
Another method is to use API Functions as shown below
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)
Public Function TimeToMillisecond() As String
Dim tSystem As SYSTEMTIME
Dim sRet
On Error Resume Next
GetSystemTime tSystem
sRet = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & _
":" & tSystem.wMilliseconds
TimeToMillisecond = sRet
End Function
Millisecond timer using VBA, How to get milliseconds in VBA Now() function, VBA Now() function, VBA Timer function , Excel VBA Timer, VBA Milliseconds

Excel VBA uninstall Excel Addins

Programmatically uninstall Excel Addins using VBA

Sub UnInstall_Addins_From_EXcel_AddinsList()
Dim oXLAddin As AddIn
For Each oXLAddin In Application.AddIns
Debug.Print oXLAddin.FullName
If oXLAddin.Installed = True Then
oXLAddin.Installed = False
End If
Next oXLAddin
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

Retrieve / Get First Row of Excel AutoFilter using VBA

Extract First Row of the Filtered Range using Excel VBA



We can create filters programmatically using Excel VBA () and also add multiple criteria to it (). Once we get the filtered data, either we extract the same or iterate each row in it and do some operations. Here is one such simple program to extract the rows of filtered range using VBA


Sub Get_Filtered_Range()


Dim oWS As Worksheet

Dim oRng As Range

Dim oColRng As Range

Dim oInRng As Range


On Error GoTo Err_Filter


oWS = ActiveSheet



oWS.UsedRange.AutoFilter(Field:=2, Criteria1:="Banana")


oRng = oWS.Cells.SpecialCells(xlCellTypeVisible)



oColRng = oWS.Range("A2:A5000")

oInRng = Intersect(oRng, oColRng)


MsgBox("Filtered Range is " & oInRng.Address)

MsgBox("First Row Filtered Range is " & oInRng.Rows(1).Row)




Finally:


If Not oWS Is Nothing Then oWS = Nothing


Err_Filter:

If Err <> 0 Then

MsgBox(Err.Description)

Err.Clear()

GoTo Finally

End If



End Sub







UnInstall Word Addins using VBA


Here is a simple method to uninstall a Word Addin (.dot file) using Word VBA
Private Sub UnInstalled_AllWordAddins()
Dim oAddin As AddIn
On Error GoTo Err_Addin
For Each oAddin In AddIns
If oAddin.Installed Then
msg = oAddin.Name
oAddin.Installed = False
End If
Next oAddin
Finally:
If Not oAddin Is Nothing Then Set oAddin = Nothing
Err_Addin:
If Err < > 0 Then
Err.Clear
GoTo Finally
End If
End Sub

Installed Word Addin

Word Addin List after Macro Execution. Addin is uninstalled (not removed)

Word VBA add command buttons through code

Add CommandButton to Word Document using VBA (through AddOLEControl)
Here is one of the ways to add a command button on a Word document using Word VBA
Sub Macro_Add_Button()
Dim oCtl
Dim oCmd
Set oCtl = ActiveDocument.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1")
Set oCmd = oCtl.OLEFormat.Object
oCmd.Caption = "Click Me..."
End Sub



Update Word Document with Excel Information using VBA


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

Excel to Word using VBA




Wednesday, May 02, 2012

How to Make a File ReadOnly using Excel VBA

How to Create ReadOnly Files using VBA - Excel VBA ReadOnly Function

There are many occassions where you want to save the file as Readonly (at times with a Password protection) after you complete the process. We have talked about SetAttr that changes the file attributes. Now let us see how to do this using FileSystemObject

Please refer How to iterate through all Subdirectories till the last directory in VBA to know how to include the references if you are using Early binding.

The following snippet uses late binding and shows how to set the file as read-only



Function MakeFileReadOnly(ByVal sFile As String)

Dim strSaveFilename As String

Dim oFSO As Object      'Scripting.FileSystemObject
Dim oFile As Object     'Scripting.File


    ' Create Objects
    ' Uses Late Binding
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.GetFile(FilePath:=sFile)

    ' Set file to be read-only
    oFile.Attributes = 1
 
    ' Releasing Objects
    If Not oFSO Is Nothing Then Set oFSO = Nothing
    If Not oFile Is Nothing Then Set oFile = Nothing

End Function
The function is not restricted to Excel files alone and can be used for any kind of files

Once You are done you can  Check Workbook Attributes to confirm if the Workbook is ReadOnly

Wednesday, February 29, 2012

How to Create Hyperlinks in multiple cells using EXcel VBA

How to Link Cells to Files/Folders using Excel VBA

There are many cases where we want to have a Hyperlink on a cell that opens a document / image etc.
In the following snippet we can see how that works

The sheet is the Master Sheet, which contains the list of Products that are compared. The comparison reports for these products are placed in separate files in the same folder.



The hyperlink uses Relative path - you can hardcode this to any particular folder

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 Split Text in a Cell to Multiple Cells using Excel VBA

Convert a Text to Range using Excel VBA

The following snippet converts the Text to an Array by splitting using SemiColon delimiter and uses the Transpose Function to place it in the Range


Sub ConvertText2Range()

Dim sText As String, arText

sText = Range("c16").Value

arText = Split(sText, ";")

Range("D16:D" & CStr(16 + UBound(arText))).Value = WorksheetFunction.Transpose(arText)
End Sub


Friday, February 03, 2012

How to convert Excel Text to Comments using VBA

Convert Excel Range to Comments using VBA

We have seen how to Copy Comments in an Excel Sheet to a Range; now let us see how to do the opposite

Our reference Excel has Text that needs to be converted as Comments on Column E, which needs to be placed as comments

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


If you already have comments and try to AddComment then Runtime Error 1004 will be thrown. That is why it is better to Remove the existing comments (ClearComments) and proceed with Adding new comment

Monday, January 30, 2012

How to Extract Comment information from Word VBA

How to Extract Comments Text and Related Information from Word Document using VBA

Here is a hint of accessing the comments and related information using VBA

Sub Get_Comment_Information()

Dim oComment As Comment
Dim oCommentRange As Range

For i1 = 1 To ActiveDocument.Comments.Count
    Set oComment = ActiveDocument.Comments(i1)
    Set oCommentRange = oComment.Scope.Paragraphs(1).Range
    Debug.Print "Page : " & oCommentRange.Information(wdActiveEndPageNumber) & vbTab _
                     & "Line : " & oCommentRange.Information(wdFirstCharacterLineNumber) & vbTab

    

Next i1

End Sub

How to Identify and Tag Numbered Lists using VBA

How to Identify and Tag Bullet Lists using VBA

Following snippet identifies a Bulleted List and Tags all Bullet List items and the Bulletted List as a whole

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

    Compare Word Documents with Headers and Footers using VBA

    How to Compare Word Documents Programatically using Word VBA

    Word Documents are everywhere .. proposals, tenders, notes, technical papers. In many cases there are more than one authors and more than five reviewers. There is a devil in everyone which comes out when reviewing the document. Suggest some changes.. boldface  some text, markup some paragraph and screw the document. If you are  the author it is your responsibility to ensure that the changes get reflected. There are many document management solutions that are available for parallel working.

    Just in case you get a document reviewed by your boss (and without track changes) and you want to know what he/she has done use the following

    Sub CompareDoc()
    
    Dim oDoc1 As Document
    Dim oDoc2 As Document
    
    Set oDoc1 = Documents.Open("D:\Changed Header.doc")
    Set oDoc2 = Documents.Open("D:\Original Header.doc")
    Application.CompareDocuments oDoc1, oDoc2, wdCompareDestinationNew, , , , , , True, True
    
    End Sub
    

    This compares two documents and creates a new document with Track Changes showing the changes.


    There are lot of parameters to CompareDocuments method. The notable being CompareFormatting, CompareHeaders, CompareFootnotes. The last two ones are used if you want to know the changes made in Headers and Footers. Who knows you would have kept the same header from the document you cloned and your boss would have noticed and changed it. Do you want to take risk of ignoring that

    See also
    Comparing two Word Documents using Word VBA
    Compare Files by Date

    How to Convert Word Table to PDF using VBA

    Export Word Table as PDF using VBA

    Anyone who is using Word for quite sometime will agree that Tables and Images are bit scary when it comes to viewing across versions or machines. A Table which looks great in your machine might not look so if he uses a different version of Word.

    In that case it is better to have the Table converted as PDF in your machine and circulate the same. In last post we saw how to export part of text to a new document using ExportFragment method. Here we export a Table as PDF using ExportAsFixedFormat method.

    The following snippet does exactly the same:

    Sub Table2PDF()
    
    Dim oTab As Word.Table
    Dim oRange As Word.Range
    
    Set oTab = ActiveDocument.Tables(1)
    
    oTab.Range.ExportAsFixedFormat "D:\Documents and Settings\Admin\My Documents\Tab_PDF.pdf", wdExportFormatPDF
    
    End Sub
    

    See also:
    Convert Word to PDF using VBA

    How to Export Parts of Document using Word VBA

    Copy Content with Formatting to New Document using Word VBA

    Not all the tens and hundreds of pages in a Word document interests you or matters to you. There are some documents, which we use for reference. All we need is a paragraph/section from the document. If it is a book we used to take a photo-copy of the same and keep it in a folder. How to do the same in a Word document - and in an automated way with all the formatting intact?

     ExportFragment method in Word VBA provides the solution. It creates a new document from the existing one for the Range of your choice.

    Here is an example where it exports eleventh paragraph of the document to a new one.

    Sub PartofText()
    
    Dim oWDRange As Word.Range
    
    Set oWDRange = ActiveDocument.Paragraphs(11).Range
    oWDRange.ExportFragment "D:\Documents and Settings\Admin\My Documents\Reference_11.docx", wdFormatDocumentDefault
    
    End Sub
    

    See also

    How to Format Part of Content Controls in Word VBA

    Word VBA - Format Some portion of Rich Text Content Control Programatically

    ContentControls have become ubiquitous with Word documents nowadays. Rich Text Content Control is used by many developers and authors to represent useful information.

    At times there is a necessity to highlight / format some part of the Text in that control. You can either search for the text and highlight it or Highlight them based on position

    The following example shows how to boldface certain portion of ContentControl

    Sub FormatContentControl()
    
    Dim oCC As ContentControl
    Dim oCCRange As Range
    Dim oCCRngFormat As Range
    Dim oChr As Range
    
    Set oCC = ActiveDocument.ContentControls(1)
    oCC.Type = wdContentControlRichText
    Set oCCRange = oCC.Range
    Set oCCRngFormat = oCCRange.Duplicate
    
    oCC.LockContentControl = False
    oCC.LockContents = False
    
    oCCRngFormat.Start = 20
    oCCRngFormat.End = oCCRange.End
    
    For Each oChr In oCCRngFormat.Characters
        oChr.Font.Bold = True
    Next oChr
    
    oCCRngFormat.Font.Bold = -1
    oCCRngFormat.Font.Underline = WdUnderline.wdUnderlineSingle
    
    oCCRngFormat.Start = oCCRange.End
    oCCRngFormat.Font.Bold = 0
    oCCRngFormat.Font.Underline = WdUnderline.wdUnderlineNone
    
    
    End Sub
    

    See also
    How to retrieve value from Content Controls using Word VBA
    How to add Content Controls using VBA

    Sunday, January 29, 2012

    How to Search and Highlight/Tag a string in Word VBA

    How to Search Content for Specific String/Text using Word VBA

    This action is performed often by programmers - there are couple of ways to do

    1. Selection.Find
    2. Content.Find

    We will have a look at how to search a string, highlight the string and tag the same using Word VBA. This needs document to be open

    Sub Highlight_Tag_Found_Word()
    
    Dim sFindText As String
    
    sFindText = "Olympics"
    
    Selection.ClearFormatting
    
    Selection.HomeKey wdStory, wdMove
    
    Selection.Find.ClearFormatting
    
    Selection.Find.Execute sFindText
    
     
    
    Do Until Selection.Find.Found = False
    
            Selection.Range.HighlightColorIndex = wdPink
            
            Selection.InsertBefore "< FoundWord >"
            
            Selection.InsertAfter < /FoundWord >
            
            Selection.MoveRight
            
            Selection.Find.Execute
    
    Loop
    
     
    
    End Sub
    
    

    Saturday, January 21, 2012

    How to create a Trendline Chart using Excel VBA

    Excel VBA - Trendline Charts

    Here are some snippets useful to create a TrendLine Chart in Excel

    Have used the entire data from the given sheet to create the chart. Have used the UsedRange function to get that.

    If you want to have a specified range you can pass that also

    Sub Create_TrendLine_Chart_Excel_2003(ByRef oRep As Worksheet, ByVal iLeft As Double, ByVal iTop As Double, ByVal sChartTitle As String, ByRef oSource As Range)
    Dim oChts As ChartObjects           '* Chart Object Collection
    Dim oCht As ChartObject             '* Chart Object

    On Error GoTo Err_Chart
        Set oChts = oRep.ChartObjects
        Set oCht = oChts.Add(iLeft, iTop, 400, 450)
       
        oCht.Chart.SetSourceData oSource, PlotBy:=xlColumns
        oCht.Chart.ChartType = xlLineMarkers
       
        oCht.Chart.HasTitle = True
        oCht.Chart.ChartTitle.Text = sChartTitle
       
        oCht.Chart.Legend.Position = xlLegendPositionRight
       
        oCht.Chart.HasAxis(XlAxisType.xlCategory) = True
        oCht.Chart.Axes(XlAxisType.xlCategory, xlPrimary).HasTitle = True
        oCht.Chart.Axes(XlAxisType.xlCategory, xlPrimary).AxisTitle.Characters.Text = ""
       
        oCht.Chart.HasAxis(XlAxisType.xlValue) = True
        oCht.Chart.Axes(XlAxisType.xlValue, xlPrimary).HasTitle = True
        oCht.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Percentage Done" '.Axes(Type:=XlAxisType.xlValue).AxisTitle.Text = "% Done"
        oCht.Chart.Axes(xlValue).MaximumScale = 1
       
        oCht.Chart.Axes(xlCategory).TickLabelSpacing = 1
        oCht.Chart.Axes(xlCategory).TickLabels.Font.Size = 8
       
        'oCht.Chart.SetElement (msoElementPrimaryCategoryGridLinesMajor)

        If Not oCht Is Nothing Then Set oCht = Nothing
        If Not oChts Is Nothing Then Set oChts = Nothing


    Err_Chart:
    If Err <> 0 Then
       Debug.Assert Err = 0
       Debug.Print Err.Description
       If Err.Number = 94 Then  'Invalid Use of Null Error
            Err.Clear
            Resume Next
       Else
            Err.Clear
            Resume Next
       End If
    End If


    End Sub

    For some reason the above was creating a problem in Excel 2007 and above. Hence created a separate snippet for it

    Sub Create_TrendLine_Chart_Excel_2007(ByRef oRep As Worksheet, ByVal iLeft As Double, ByVal iTop As Double, ByVal sChartTitle As String)
    Dim oChts As ChartObjects           '* Chart Object Collection
    Dim oCht As ChartObject             '* Chart Object

    On Error GoTo Err_Chart
        Set oChts = oRep.ChartObjects
        Set oCht = oChts.Add(iLeft, iTop, 400, 450)
       
        oCht.Chart.ChartWizard Source:=oRep.UsedRange
        oCht.Chart.ChartType = xlLineMarkers
       
        oCht.Chart.HasTitle = True
        oCht.Chart.ChartTitle.Text = sChartTitle
       
        oCht.Chart.Legend.Position = xlLegendPositionRight
       
       
        oCht.Chart.HasAxis(XlAxisType.xlCategory) = True
        oCht.Chart.Axes(XlAxisType.xlCategory, xlPrimary).HasTitle = True
        oCht.Chart.Axes(XlAxisType.xlCategory, xlPrimary).AxisTitle.Characters.Text = ""
       
        oCht.Chart.HasAxis(XlAxisType.xlValue) = True
        oCht.Chart.Axes(XlAxisType.xlValue, xlPrimary).HasTitle = True
        oCht.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Percentage Done" '.Axes(Type:=XlAxisType.xlValue).AxisTitle.Text = "% Done"
        oCht.Chart.Axes(xlValue).MaximumScale = 1

        'oCht.Chart.SetElement (msoElementPrimaryCategoryGridLinesMajor)

    Err_Chart:
    If Err <> 0 Then
       Debug.Assert Err = 0
       Debug.Print Err.Description
       If Err.Number = 94 Then  'Invalid Use of Null Error
            Err.Clear
            Resume Next
       Else
            Err.Clear
            Resume Next
       End If
    End If


    End Sub

    ChartType = xlLineMarkers makes this Chart a TrendLine. You can try your luck by selecting other types
    Related Posts Plugin for WordPress, Blogger...

    Visual Basic for Applications (VBA) Forum (recent threads)

    CodeKeep VBA Feed

    Visual Studio Tools for Office Forum (recent threads)

    Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.

    Office Business Applications (OBA) Team Blog

    MSDN Code Gallery Published Resources For Tag VSTO

    microsoft.public.vsnet.vstools.office Google Group