• Selecting non-contiguous (non adjacent) Ranges/ Rows/ Columns/ Cells in Microsoft Excel Sheets using VBA

• Getting the last used/populated Column/Row number in Microsoft Excel Sheets using VBA

• Getting the physical Page Count(the number of pages a given excel worksheet would print when sent to printer) of a Microsoft Excel worksheet

• Using ActiveX Data Objects(ADOs) in Microsoft Excel(The example demonstrates getting data into Microsoft Excel using a DSN)

• Programatically removing all the Links to external workbooks from an Excel Workbook

• Populating a Powerpoint Table (Group) with Data from Microsoft Excel using VBA

• Get Data into a Powerpoint Graph from Microsoft Excel using VBA (Example demonstrates programatically accessing the Datasheet that's behind a Powerpoint Graph Object and also the Graph's X,Y Axes and Markers Properties)

• Add Notes(Text) to a Powerpoint slide NotesPage Programatically(from within Powerpoint application)

You can Download PowerPoint Add-in to Rename Shapes on Slides from Microsoft

Selecting non-contiguous (non adjacent) Ranges/Rows/Columns/Cells in Excel Sheet using VBA

'Code by Mahipal Padigela
'Open Microsoft Excel,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Sub RangeSelection()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Range
    Dim rng5 As Range
    'set some random ranges	    
    Set rng1 = Range(Cells(1, 1), Cells(4, 1))
    Set rng2 = Range(Cells(1, 6), Cells(4, 6))
    Set rng3 = Range("A6:D10")
    Set rng4 = Range(Rows(13), Rows(15))
    Set rng5 = Range("H:H")
    'you can pass up to 30 Ranges as parameters, I think
    Application.Union(rng1, rng2, rng3, rng4, rng5, Range("17:17,19:19"), Range("G25")).Select
End Sub

Top

Getting the last used/populated Column/Row number in Microsoft Excel Sheets using VBA

'Code by Mahipal Padigela
'Open Microsoft Excel,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Sub lastRow()
    'to get the last row number use .....
    MsgBox ActiveSheet.UsedRange.Rows.Count
    'or.....
    MsgBox ActiveSheet.Range("A65536").End(xlUp).Row

    'And to get the last column number....
    MsgBox ActiveSheet.UsedRange.Columns.Count
End Sub

Top

Getting the physical Page Count (the number of pages a given excel worksheet would print when sent to printer) of a Microsoft Excel worksheet

'Code by Mahipal Padigela
'Open Microsoft Excel,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'add some, say a couple of hundred rows of test data to sheet1
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Sub pagecount()
    'assumes that the first sheet name is 'Sheet1', so please change if otherwise
    Sheet1.Activate
    MsgBox ExecuteExcel4Macro("Get.Document(50)")
End Sub

Top

Using ActiveX Data Objects(ADOs) in Microsoft Excel(The example demonstrates getting data into Microsoft Excel using a DSN)

'Code by Mahipal Padigela
'Open Microsoft Excel,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Add a reference to 'Microsoft ActiveX data Objects 2.6 Object Library'(Tools-->References)
'Change the DSN and Sql query in the Code
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Sub ADOexample()
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    Dim strSql As String

    Set conn = New ADODB.Connection
    conn.Open "DSN=11472a"
    Set rs = New ADODB.Recordset
    strSql = "SELECT * FROM Company"
    rs.Open conn, strSql
 
   ' Loop through all of the recordset fields and add column headers to worksheet
    For i = 0 To rs.Fields.Count - 1
       ActiveWorkbook.Sheets(1).Range("a1").Offset(0, i).Value = rs.Fields(i).Name
    Next i
    'Next line copies the recordset data to the worksheet (Let me remind you that you 
    'can also loop through the recordset and process the data row by row, instead of using copy method)
    ActiveWorkbook.Sheets(1).Range("a2").CopyFromRecordset rs
    
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
End Sub

Top

Programatically removing all the Links to external workbooks from an Excel Workbook

'Code by Mahipal Padigela
'Open the Microsoft Excel file with the Links to external workbooks,then 
'goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Close VB Editor and run this Macro from Excel window(Alt+F8) (Make sure you take of the data 
'referenced from all external workbooks before running  the Macro as it removes all links

Sub RemoveLinks()
    Dim Link As Variant
    If ActiveWorkbook.LinkSources Then
      If MsgBox("Sure you want to delete all external links?", vbYesNo + vbQuestion, "RemoveLinks") _
		 = vbYes Then
            For Each Link In ActiveWorkbook.LinkSources
                ActiveWorkbook.BreakLink Name:=Link, Type:=xlLinkTypeExcelLinks
            Next
            MsgBox "All Links to external workbooks have been removed"
      Else
            Exit Sub
      End If
    Else
        MsgBox "No Links to external workbooks have been found"
    End If
End Sub

Top

Populating a Powerpoint Table (Group) with Data from Microsoft Excel using VBA

'Code by Mahipal Padigela
'Open Microsoft Powerpoint,Choose/Insert a Table type Slide(No.4), then double click to add a...
'...Table(3 Cols & 2 Rows) then rename the Table to "Table1", Save and Close the Presentation
'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some data in...
'... Rows 1,2 and Columns 1,2,3)
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references)
'Change "strPresPath" with full path of the Powerpoint Presentation created earlier.
'Change "strNewPresPath" to where you want to save the new Presnetation to be created later
'Close VB Editor and run this Macro from Excel window(Alt+F8) 

Dim oPPTApp As PowerPoint.Application
Dim oPPTShape As PowerPoint.Shape
Dim oPPTFile As PowerPoint.Presentation
Dim SlideNum As Integer
Sub PPTableMacro()
    Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
    strPresPath = "H:\PowerPoint\Presentation1.ppt"
    strNewPresPath = "H:\PowerPoint\new1.ppt"
    
    Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = msoTrue
    Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
    SlideNum = 1
    oPPTFile.Slides(SlideNum).Select
    Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")
    
    Sheets("Sheet1").Activate
    oPPTShape.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = Cells(1, 1).Text
    oPPTShape.Table.Cell(1, 2).Shape.TextFrame.TextRange.Text = Cells(1, 2).Text
    oPPTShape.Table.Cell(1, 3).Shape.TextFrame.TextRange.Text = Cells(1, 3).Text
    oPPTShape.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = Cells(2, 1).Text
    oPPTShape.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = Cells(2, 2).Text
    oPPTShape.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = Cells(2, 3).Text
  
    oPPTFile.SaveAs strNewPresPath
    oPPTFile.Close
    oPPTApp.Quit
          
    Set oPPTShape = Nothing
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
    
    MsgBox "Presentation Created", vbOKOnly + vbInformation
End Sub

Top

Get Data into a Powerpoint Graph from Microsoft Excel using VBA

'Code by Mahipal Padigela
'Open Microsoft Powerpoint,Choose/Insert a Graph type Slide(No.8), then double click to add a graph and click...
'...outside the graph to close the Datasheet, then rename the Graph to "Mychart",Save and Close the Presentation
'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some test data...
'...(numbers between 0-100) in Rows 2,3,4 and Columns B,C,D,E).
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references)
'Reference 'Microsoft Graph Object Library' (VBA IDE-->tools-->references)
'Change "strPresPath" with full path of the Powerpoint Presentation created earlier.
'Change "strNewPresPath" to where you want to save the new Presnetation to be created later
'Close VB Editor and run this Macro from Excel window(Alt+F8) 

Dim oPPTApp As PowerPoint.Application
Dim oPPTShape As PowerPoint.Shape
Dim oPPTFile As PowerPoint.Presentation
Public oGraph As Graph.Chart
Dim SlideNum As Integer

Sub PPGraphMacro()
    Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
    strPresPath = "H:\PowerPoint\Presentation1.ppt"
    strNewPresPath = "H:\PowerPoint\New1.ppt"
    
    Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = msoTrue
    Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
    SlideNum = 1
    oPPTFile.Slides(SlideNum).Select
    Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Mychart")
    Set oGraph = oPPTShape.OLEFormat.Object
    
    Sheets("Sheet1").Activate
    oGraph.Application.DataSheet.Range("A1").Value = Cells(2, 2).Value
    oGraph.Application.DataSheet.Range("A2").Value = Cells(3, 2).Value
    oGraph.Application.DataSheet.Range("A3").Value = Cells(4, 2).Value
    oGraph.Application.DataSheet.Range("B1").Value = Cells(2, 3).Value
    oGraph.Application.DataSheet.Range("B2").Value = Cells(3, 3).Value
    oGraph.Application.DataSheet.Range("B3").Value = Cells(4, 3).Value
    oGraph.Application.DataSheet.Range("C1").Value = Cells(2, 4).Value
    oGraph.Application.DataSheet.Range("C2").Value = Cells(3, 4).Value
    oGraph.Application.DataSheet.Range("C3").Value = Cells(4, 4).Value
    oGraph.Application.DataSheet.Range("D1").Value = Cells(2, 5).Value
    oGraph.Application.DataSheet.Range("D2").Value = Cells(3, 5).Value
    oGraph.Application.DataSheet.Range("D3").Value = Cells(4, 5).Value

'Should you need to access the Graph axes to turn them On/Off or to set ranges etc etc...use this
'   oGraph.HasAxis(xlValue, xlPrimary) = True  ' Shows Y-axis on the graph
'   Set oAxis = oGraph.Axes(xlValue)
'   With oAxis
'       .MinimumScale = 0
'       .MaximumScale = 1.2
'   End With
'   oGraph.HasAxis(xlValue, xlPrimary) = False ' Hides Y-axis on the graph 
'Should you need to access the Graph's Markers to change their Color based on Data at...
'...runtime etc...use this(Not applicable to the graph in this example but to Graphs with Markers like..
'... Bubble, Line etc. Scatter charts)
'    Dim i as Integer
'    For i = 1 To oGraph.SeriesCollection(1).Points.Count
'        If oGraph.Application.DataSheet.Cells(i, 2).Value >= 50 Then
'            oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 3
'            oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 3
'        Else
'            oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 6
'            oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 6
'        End If
'    Next i 

    oGraph.Application.Update
    oGraph.Application.Quit
  
    oPPTFile.SaveAs strNewPresPath
    oPPTFile.Close
    oPPTApp.Quit
    
    Set oGraph = Nothing
    Set oPPTShape = Nothing
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
    MsgBox "Presentation Created", vbOKOnly + vbInformation
End Sub

Top

Add Notes(Text) to a Powerpoint slide NotesPage Programatically(from within Powerpoint application)

'Code by Mahipal Padigela
'Open Microsoft powerpoint application and add a Slide
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Close VBA Editor and run this Macro from Powerpoint window(Alt+F8) 
Sub AddNotestoPP()
    Dim Sl As Slide
    Dim Sh As Shape
    Dim strNotesPageText As String
  
    strNotesPageText = "Add some text like......Mahipalreddy.com Free Excel Powerpoint" & vbCrLf _
    &  " VBA Source codes also ASP, Sql server, Crystal reports, UML, software " _ 
	&  " engineering, Database design Resources"
    
    Set Sl = ActivePresentation.Slides(1)
    If Sl.NotesPage.Shapes.Count = 0 Then 'If no shapes to take Notes then add a shape first	
        Sl.NotesPage.Shapes.AddShape msoShapeRectangle, 0, 0, 0, 0
        Sh = Sl.NotesPage.Shapes(1)
        Sh.TextFrame.TextRange.Text = strNotesPageText
    Else    'has shapes, so see if they take text
        For Each Sh In Sl.NotesPage.Shapes
            If Sh.HasTextFrame Then
                Sh.TextFrame.TextRange.Text = strNotesPageText
                Exit For
            End If
        Next Sh
    End If
End Sub

Top