I'm "very" new at this. I am currently working with a ppt file containing ~120 slides, each containing a table with identical fields but different values. I want to copy these tables into an Excel file. There is no chart associated with the tables.
I don't care about the field names but just the value and I am looking for a VBA code to do automate this.
Is it even possible or is to too simple. I tried recording a PPT macro for copying the table (alt + t + m + r) but am not sure what to do after that, or how to start an Excel file to paste this macro etc.
Any help would be extremely appreciated.
I'm not all that good with Excel, but perhaps someone else who is can fill in the blanks here. This is more or less what you'd need to locate the first table on each slide in PowerPoint and do something with it. Perhaps someone who's good with Excel will fill in the missing bits.
Sub CopyTables()
Dim oSl As Slide
Dim oTbl As Table
Dim lCol As Long
Dim lRow As Long
For Each oSl In ActivePresentation.Slides
Set oTbl = GetFirstTable(oSl)
If oTbl Is Nothing Then
Exit For
End If
With oTbl
For lCol = 1 To .Columns.Count
For lRow = 1 To .Rows.Count
Debug.Print oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange.Text
Next
Next
End With
Next
End Sub
Function GetFirstTable(oSl As Slide) As Table
Dim oSh As Shape
For Each oSh In oSl.Shapes
If oSh.HasTable Then
Set GetFirstTable = oSh.Table
Exit Function
End If
Next
End Function
Related
I have an excel workbook with the julian day in column one, the normal high temperature in column two, and the normal low temperature in column three. I need to write a script in PowerPoint VBA to match the current Julian Day with the same number in Column one in the workbook. Then I need it to extract the normal high for that day (Column two) and insert that number into a named shape in a particular PPT slide. Here is what I have so far:
Function SectionIndexOf(sSectionName As String) As Long
'This Function makes sure you can declare the name of any Section Name
'in the Sub below.
Dim x As Long
With ActivePresentation.SectionProperties
For x = 1 To .Count
If .Name(x) = sSectionName Then
SectionIndexOf = x
End If
Next
End With
End Function
Sub Climo()
Headlines = SectionIndexOf("Headlines")
'Open the Excel Workbook.
Dim CLI As New Excel.Workbook
Set CLI = Excel.Application.Workbooks.Open("Z:\climo.xlsx")
'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Dim NormalHi As String
Dim NormalLo As String
Dim shp As Shape
Dim sld As Slide
Set WS = CLI.Worksheets(1)
Dim i As Long
'Loop through all rows in Column A (Julian Day)
For i = 1 To WS.Range("A372").End(xlUp).Row
NormalHi = WS.Cells(i, 9).Value
Debug.Print NormalHi 'This just returns new blank lines
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If sld.sectionIndex = Headlines Then
With sld.Shapes("NormalHi")
.TextFrame2.TextRange.Font.Name = Arial
.TextFrame2.TextRange.Font.Size = 16
.TextFrame.TextRange.Font.Color = vbRed
.TextFrame2.TextRange.Text = NormalHi
End With
End If
Next
Next
Next
End Sub
Before even trying to figure out how to match the current Julian Day with the proper row in the Excel workbook, I am just trying to extract data from any cell and plot it in the shape. I get no errors when I run this and using Debug.Print gives me blank new lines. Not sure what is wrong. Thanks!
You mention in your question that the Normal High data is found in column 2 but then when you are grabbing the value, you're referencing column 9. Perhaps that's the issue?
NormalHi = WS.Cells(i, 9).Value
I want to delete everything in my powerpoint presentation, except the charts that are already there. I have been searching for day with no avail.
I did however find this VBA that deletes all charts. Unfortunately, it is the opposite of what I am trying to achieve. I have tried using VBA found in other code and adding it, but nothing helps. Any help would be much appreciated.
Sub RemoveAllCharts()
Dim sld As Slide
Dim i, num
'Loop Through Each Slide in ActivePresentation
For Each sld In ActivePresentation.Slides
num = sld.Shapes.Count
For i = num To 1 Step -1
If sld.Shapes(i).HasChart Then
sld.Shapes(i).Delete
End If
Next i
Next sld
End Sub
You might be able to add a Not to achieve this, i.e. change
If sld.Shapes(i).HasChart Then
to
If Not sld.Shapes(i).HasChart Then
Sub RemoveAllButCharts()
Dim sld As Slide
Dim i As Long, num As Long
'Loop Through Each Slide in ActivePresentation
For Each sld In ActivePresentation.Slides
num = sld.Shapes.Count
For i = num To 1 Step -1
If Not sld.Shapes(i).HasChart Then
sld.Shapes(i).Delete
End If
Next i
Next sld
End Sub
I have a sheet that organizes, stylizes, and summarizes data, and then copies itself and saves another copy as a .PDF.
On the original sheet, there are 3 "Buttons" made out of groups of shapes to run different macros ("Reset", "Fix Missing Employees", "Print and Email Summary". The problem is in deleting them on the copy. This is from a recorded macro:
ActiveSheet.Shapes.Range(Array("Group 2")).Select
Selection.Delete
I want to select/delete ALL shapes. I can't use "shapes.select", "shapes.delete", or anything else I've found help for. Every attempt beside the code listed above results in "Error 438 -- Object doesn't support this property or method" and it highlights that portion of the code.
How can I select/delete all shapes in a worksheet/book? (Using Excel 2010)
You do not need to select all the Shapes in a worksheet to delete them. A loop will do:
Sub ShapeKiller()
Dim sh As Shape
MsgBox ActiveSheet.Shapes.Count
For Each sh In ActiveSheet.Shapes
sh.Delete
Next sh
End Sub
You can delete more than one Shape at the same time. Here is an example that finds a certain row and deletes all the Shapes whose upper corner is in that row:
Sub ShapePickerAndKiller()
Dim s As Shape, sr As ShapeRange
Dim Arr() As Variant
Set mycell = Range("A:A").Find(What:=0, After:=Range("A1"))
rrow = mycell.Row
i = 1
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Row = rrow Then
ReDim Preserve Arr(1 To i)
Arr(i) = s.Name
i = i + 1
End If
Next s
Set sr = ActiveSheet.Shapes.Range(Arr)
sr.Select
Selection.Delete
End Sub
See older post
Here's the final solution I used:
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Type <> msoPicture Then
sh.Delete
End If
Next sh
The reason is because I had one shape I wanted to keep, with a logo of the company--The Shape Object approach made it very easy to handle this, because of the Shape.Type attribute (As one shape was a msoPicture, and the rest were msoRoundedRectangles). Also helpful, had there been one picture I wanted to delete would have been Shape.Name to name the one to delete or skip.
Shout out to #Gary's Student for pointing me down this path!
I have the below code which adds periods to the body of a PPT slide:
Sub TitlePeriod()
On Error Resume Next
Dim sld As Slide
Dim shp As Shape
Dim strTitle As String
For Each sld In ActivePresentation.Slides
If sld.Shapes.HasTitle = True Then 'check if there is a title
strTitle = sld.Shapes.Title.TextFrame.TextRange.Text
Else
strTitle = ""
End If
For Each shp In sld.Shapes
'add periods only if text of shape is not equal to title text.
If strTitle <> shp.TextFrame.TextRange.Text Then
shp.TextFrame.TextRange.AddPeriods
If shp.HasTable Then
shp.TextFrame.TextRange.AddPeriods
End If
End If
Next shp
Next sld
End Sub
I am trying to add bit to the code that will add periods to tables within a slide as well
If shp.HasTable Then
shp.TextFrame.TextRange.AddPeriods
When I run the code there are not errors, but there are no periods added within the table. Would love some advice or any tips on how to fix this.
Thanks in advance
First, I would like to offer some advice. When trying to figure out issues like this, it is best to try to examine the object in the locals window. This way, you can search through the properties of the object (in this case, the shape object, shp, which happens to be a Table) and figure out which properties you need to modify to achieve your desired results. No offense meant, but from your questions, it appears that you are new to VBA and found some of this code somewhere.
Also, the code was actually causing an error for me, as the Table shape did not have a textframe (although I only made a test table....perhaps yours actually had one). I added a check for the textFrame.
For your specific question, a shape object with a table, has a Table property that needs to be used to add things to the cells. The Table, in turn, has a Columns object which is a collection of columns. You need to loop through all of the columns. Each column is a collection of cells, so you need to loop through the cells. Each cell has the textframe and textrange objects you are looking for, so you need to run the .AddPeriods method on these objects.
Sub TitlePeriod()
On Error Resume Next
Dim sld As Slide
Dim shp As Shape
Dim strTitle As String
Dim myTable As Table
Dim myColumns As Columns
Dim col As Column
Dim myCell As Cell
For Each sld In ActivePresentation.Slides
If sld.Shapes.HasTitle = True Then 'check if there is a title
strTitle = sld.Shapes.Title.TextFrame.TextRange.Text
Else
strTitle = ""
End If
For Each shp In sld.Shapes
'add periods only if text of shape is not equal to title text.
If shp.TextFrame.HasText Then 'check to make sure there is text in the shape
If strTitle <> shp.TextFrame.TextRange.Text Then
shp.TextFrame.TextRange.AddPeriods
End If
End If
If shp.HasTable Then 'Check to see if shape is a table
Set myTable = shp.Table 'Get the table object of the shape
Set myColumns = myTable.Columns 'Get the columns of the table
For Each col In myColumns 'Loop through the columns
For Each myCell In col.Cells 'Loop through the cells in the column
myCell.Shape.TextFrame.TextRange.AddPeriods 'Add periods to the cell
Next myCell
Next col
End If
Next shp
Next sld
End Sub
I have a powerpoint presentation with an excel workbook embedded in one of the slides. I also have a userform that I want the user to input information into, I want to take this information and then edit the excel sheet with the relevant information.
I don't know how to access the excel sheet within powerpoint though so I can change the values of the cells.
Sub a()
Dim oSl As PowerPoint.Slide
Dim oSh As PowerPoint.Shape
Set oSl = ActivePresentation.Slides(1)
Set oSh = oSl.Shapes(1)
With oSh.OLEFormat.Object.Sheets(1)
.Range("A1").Value = .Range("A1").Value + 1
.Range("A2").Value = .Range("A2").Value - 1
End With
Set oSl = Nothing
Set oSh = Nothing
End Sub
Inspired in this code