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
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