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
Related
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.
I have a macro in Outlook that calls an Excel file and runs a macro in that Excel file then closes the file. The problem is After closing Excel it stays in the Task Manager. I have tested this a million times and I even have removed all code in my Excel macro to see if that was the problem but Excel is still is still getting stuck in the task manager. My Outlook code is:
Dim xlApp As Object
Dim xlWB As Workbook
Dim strFile As String
Set xlApp = CreateObject("excel.application")
xlApp.Visible = True
xlApp.DisplayAlerts = False
strFile = "c:\desktop\a.xlsm"
Set xlWB = Workbooks.Open(strFile)
xlApp.Run ("Cleanup")
xlWB.Close False
If Not xlWB Is Nothing Then
Set xlWB = Nothing
End If
xlApp.Quit
If Not xlApp Is Nothing Then
Set xlApp = Nothing
End If
The problem with the code was that I was not opening the workbook with the Excel application that I created. I fixed the problem by adding xlApp here:
Set xlWB = xlApp.Workbooks.Open(strFile)
That could have not been a more simple fix to such a time consuming problem :(
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
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
I am trying to create some code that will copy the body of an email into a new Excel spreadsheet. I have this code:
Public Sub ExportToExcel1()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox).Folders("Hold Info")
Set objSearchFolder = Inbox
i = 0
For Each item In Inbox.Items
item.Display
item.Body.Select
Selection.Copy
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object ' Excel.Workbook
Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Selection.Paste False, False, False
Next
End Sub
It keeps giving me an error at item.Body.Select and I have no clue why. It may have something to do with the fact that the email I am trying to copy is nothing but tables that were generated in Oracle, but I have no clue.
You could use the Clipboard directly rather than trying to select and copy. If you have a userform in your project, you already have this reference set. If not, set a reference to Microsoft Forms 2.0 Object Library. Then use a DataObject to put some text into the Clipboard.
Public Sub ExportToExcel1()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim item As Object
Dim doClip As MSForms.DataObject
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox).Folders("Hold Info")
Set doClip = New MSForms.DataObject
For Each item In Inbox.Items
If TypeName(item) = "MailItem" Then
doClip.SetText item.Body
doClip.PutInClipboard
Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
xlApp.Visible = True
Set xlWkb = xlApp.Workbooks.Add
xlWkb.Sheets(1).Range("A1").PasteSpecial "Text"
End If
Next
End Sub
A couple of points to consider. When you use the Clipboard in this fashion, you're using the Windows Clipboard, not the Office Clipboard. The Windows Clipboard doesn't recognize Office specific Clipboard formats, so you lose a little in translation.
Pasting from the Clipboard has some advantages. But if you want complete control of how your data shows up in Excel, then read the Body into a string, parse the string for the data you want, and write the specific data to the cells you want.