Copying Named range Graph into powerpoint - vba

I am coding up a macro enable powerpoint presentation, the problem I am having is that I am trying to copy a named range (which is a graph) from an excel sheet, into a power point presentation.
Dim xlApp As Object
Dim xlWorkBook As Object
Dim path As String
Dim filename As String
Set xlApp = CreateObject("Excel.Application")
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
path = "path"
filename = "name.xlsx"
Set xlWorkBook = xlApp.Workbooks.Open(path & filename)
Set positionsheet = xlWorkBook.Sheets("Graphs")
'problem is in the below line
positionsheet.Range("Graph1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set osh = PPPres.Slides(1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)
'adjust size here...
With xlWorkBook
.Save
.Close
End With
Set xlApp = Nothing
Set xlWorkBook = Nothing
The error I receive is
runtime error 1004, object-defined error
I have tried:
positionsheet.Range("Graph1").Select
in front of the problem line...with no success.

Replace Range with Shapes, like this:
positionsheet.Shapes("Graph1")...
You must make sure that you've got the right name. It is not the same as the range, but it will show in the same box as the range names does.

Related

PowerPoint VBA to Update Embedded Spreadsheets

I have a PowerPoint with 21 embedded spreadsheets that are used to populate charts in the PowerPoint. Each week data from two spreadsheets is copied into the embedded spreadsheets to update the charts with new data. I've started working on a macro to automate this process. I have the macro to open the spreadsheets with the new data, copy the data, then open the first embedded file. I am getting a run-time error'438' Object doesn't support this property or method on the paste function.
Note: I know linked spreadsheets would be desirable, but my customer wants the embedded excel files.
Sub UpdatedEmbeddedSpreadsheets()
Dim oData As ChartData
Dim oCht As Chart
Dim xlApp As Object
Dim xlWorkBook As Object
'Open Weekly File
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("C:\abc.xlsx", True, False)
xlWorkBook.sheets("Weekly ABC Chart").Range("B2:B5").Copy
Set xlApp = Nothing
Set xlWorkBook = Nothing
'Open Embedded Spreadsheet
ActivePresentation.Slides(1).Shapes(1).Select
Set oCht = ActiveWindow.Selection.ShapeRange(1).Chart
oCht.ChartData.Activate
Set oData = oCht.ChartData
'The line below has the run-time error '438'
Debug.Print oData.Workbook.sheets("123").End(x1toright).Offset(0,-1).Paste
oData.Workbook.Close
Set oData = Nothing
Set oCht = Nothing
End Sub
Second Attempt:
Sub UpdatedEmbeddedSpreadsheets()
Dim xlApp As Object
Dim xlWorkBook As Object
'Open Weekly File
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("C:\abc.xlsx", True, False)
xlWorkBook.sheets("Weekly AVA Chart").Range("B2:B5").Copy
Set xlApp = Nothing
Set xlWorkBook = Nothing
'Open Embedded Spreadsheet
ActivePresentation.Slides(1).Shapes(1).Select
ActiveWindow.Selection.ShapeRange(1).Chart.ChartData.Activate
Dim ChartData As Object
Set ChartData = CreateObject("Excel.Application")
ChartData.Visible = True
ChartData.Workbook.sheets("123").End(xltoright).Offset(0, -1).Paste
ChartData.Workbook.Close
End Sub

Write in an already opened Excel workbook from Powerpoint Slide

I am trying to write in an already manually opened workbook using VBA from my PowerPoint presentation.
Using CreateObject and then Workbook.Open it opens a new instance of the file.
I'm trying to use GetObject as found in several examples over the web.
Here's my code :
Dim xlApp As Object
Dim xlWorkbook As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = Trueme
Set xlWorkbook = xlApp.Workbooks.Open(ActivePresentation.Path & "\Suivi individuel.xlsx", True, False)
xlWorkbook.Sheets(1).Range("C14").Value = "Hello"
SlideShowWindows(1).View.GotoSlide nextSlide
I've tried:
Dim xlApp As Object
Dim xlWorkbook As Object
Set xlWorkbook = GetObject(ActivePresentation.Path & "\Suivi individuel.xlsx", "Excel.Application")
xlWorkbook.Sheets(1).Range("C14").Value = "Hello"
SlideShowWindows(1).View.GotoSlide nextSlide
It says runtime error 432: File Name or Class Name not found during automation operation.
Try:
Dim xlApp As Object
Dim xlWorkbook As Object
Set xlWorkbook = GetObject(ActivePresentation.Path & "\Suivi individuel.xlsx")
If you just want to get an open instance of Excel then
Set xlApp = GetObject(,"Excel.Application")
Set xlWorkbook = xlApp.ActiveWorkbook
Wrap that in an error handler if there's a chance Excel might not be open
See: https://support.microsoft.com/en-us/kb/288902

Search for a given name in a range in excel before sending an email

I am creating a macro in outlook to send an eamil with some specific information in it. But only some people from the list in an excel sheet can send that email out. When they hit "SEND" on that macro, it needs to open the excel sheet and varify if that person is listed on the list. If he isn't it should just give him an error " You are not eligible to send this message" .
I am able to open the excel file using the code below. But I am not sure how to do the checking (names are listed on Sheet1 from C1: C100) to see that sending person is listed in there.
Below is my code:
[Dim strFldr As String
Dim OutMail As Object
Dim xlApp As Object
strFldr = "C:\\users-d\gxg063\Gift\test\"
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
xlApp.Workbooks.Open strFldr & "\RegionalAuthority.xlsx"]
Let me know how this works out - you'll need a reference to Excel in your Outloook VBE
Sub TestSub()
Dim strFldr As String
Dim OutMail As Object
Dim xlApp As Excel.Application
Dim xlWb As Workbook
Dim xlWs As Worksheet
Dim r As Range
Dim User As String
Dim c As Range
strFldr = "C:\\users-d\gxg063\Gift\test\"
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strFldr & "\RegionalAuthority.xlsx")
Set xlWs = xlWb.Worksheets("Sheet1")
Set r = xlWs.Range("C1:C100")
User = (Environ$("Username"))
For Each c In r
If c = User Then
'Call your Send Macro here
Exit For
End If
Next c
xlApp.Visible = True
Set xlApp = Nothing
Set xlWb = Nothing
Set xlWs = Nothing
End Sub

VBA gettng data from excel

I currently have a powerpoint with a chart that was generated through an excel.
What I need to do is get the values of the chart (or the excel, doesn't matter) in order to do some animations.
The problem is that I can't seem to get my code to work.
If there is ANY easier way to do this I will be glad to hear it!
Here's my code:
Sub moveRectangle()
Dim pptChart As Chart
Dim pptcd As ChartData
Dim xlWorkbook As Object
Dim PPPres As Presentation
Dim pptShape2 As Shape
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim sld As Slide
Dim shp As Shape
Dim PPApp As PowerPoint.Application
'Look for existing instance
On Error Resume Next
Set PPApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Create new instance if no instance exists
Set PPApp = CreateObject("Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
Set pptShape = PPPres.Slides(1).Shapes("Rectangle 16")
Set pptShape2 = PPPres.Slides(1).Shapes("Chart 3")
Set pptChart = pptShape2.Chart
Set pptcd = pptChart.ChartData
MsgBox (pptShape2.Name)
Set wb = pptcd.Workbook
Set ws = wb.Worksheets(1)
pptShape.Left = pptShape.Left - 40
End Sub
The problem is that I'm getting the following error:
Method 'Workbook' of Object 'ChartData' failed
Any help is greately appreciated!
In order to get it working without "activating" excel (which exists full screen mode, pretty annoying), what must be done is adding
With pptChart.ChartData
...
End With
This allows you to get the same functionalities without having to "activate excel"

VBA Type mismatch error when setting Excel Range in Word

I have the following code as part of my sub trying to assign a range:
'Set xlApp = CreateObject("Excel.Application")
Dim xlApp As Object
Set xlApp = GetObject(, "Excel.Application")
xlApp.Visible = False
xlApp.ScreenUpdating = False
Dim CRsFile As String
Dim CRsMaxRow As Integer
' get the CR list
CRsFile = "CRs.xls"
Set CRsWB = xlApp.Workbooks.Open("C:\Docs\" + CRsFile)
With CRsWB.Worksheets("Sheet1")
.Activate
CRsMaxRow = .Range("A1").CurrentRegion.Rows.Count
Set CRs = .Range("A2:M" & CRsMaxRow)
End With
Dim interestingFiles As Range
' get the files names that we consider interesting to track
Set FilesWB = xlApp.Workbooks.Open("files.xlsx")
With FilesWB.Worksheets("files")
.Activate
Set interestingFiles = .Range("A2:E5")
End With
Do you have any idea why am I getting a run time type mismatch error?
If you run the code from Word then the problem is in the declaration of 'interestingFiles' variable. Range exist in Word as well so use either Variant or add reference to Excel and then use Excel.Range.
Without Excel reference:
Dim interestingFiles As Variant
And with Excel reference:
Dim interestingFiles As Excel.Range
Kindly set xlApp object as in below code.
Also you provide complete path for your workbook when opening it.
Sub test()
Dim interestingFiles As Range
Dim xlApp As Object
Set xlApp = GetObject(, "Excel.Application")
' get the files names
Dim path As String
path = "C:\Users\Santosh\Desktop\file1.xlsx"
Set FilesWB = xlApp.Workbooks.Open(path)
With FilesWB.Worksheets(1)
.Activate
Set interestingFiles = .Range("A2:E5")
End With
End Sub