I have a problem while migrating my VBA code from Office2003 to Office2010. I would like to copy the text of a cell (Excel) to Powerpoint. Office2003 generated a new textbox and the style of the text was the same as in Excel. Now my code fails with Office2010 and I get the following message:
runtime error -2147188160 (80048240)
Shapes.PasteSpecial : Invalid request. Clipboard is empty or contains data which may not be pasted here.
The clipboard is definitly not empty.
The code is the following:
Set mySlides = obj_pp.ActivePresentation.Slides
mySlides(Slidenum).Shapes.PasteSpecial DataType:=ppPasteRTF
I have already tried other DataTypes and the Paste-function. Nothing helped. The text, I copy from Excel, is also formatted as text in Excel. Nothing special. The slide is added as an empty one. After adding the slide a picture is pasted (DataType:=ppPasteEnhancedMetafile). And after that the text should be pasted.
Could someone please help me to get this code work? Thanks in advance. Please let me know if more code is needed.
Edits:
Binding of the ppt:
Dim Datei As String
Pfad_Server = "..."
Pfad_Verzeichnis = "..."
Dateiname = "....pptx"
Datei = Pfad_Server & Pfad_Verzeichnis & "\" & Dateiname
Set obj_pp = (GetObject(, "Powerpoint.Application"))
obj_pp.Visible = True
IsOpen = False
Before running the macro I always open the ppt. This works fine.
Adding slide and pasting range as picture (works fine):
Range(Cells(start_var, 1), Cells(bereich_ende, 13)).Select
Selection.CopyPicture xlScreen, xlPicture
...
Set mySlides = obj_pp.ActivePresentation.Slides
mySlides.Add Index:=mySlides.Count + 1, Layout:=12 'ppLayoutBlank
mySlides(Slidenum).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
In my opinion you need to change method which copies your range. Use this lines instead your .CopyPicture line:
Selection.Copy
and it will work with pasting method:
mySlides(mySlides.Count).Shapes.PasteSpecial DataType:=9
where 9 = ppPasteRTF.
Related
I have a PowerPoint presentation in which I create charts in Excel and then link them into the PowerPoint. There are two ways to do this:
Paste Special > Paste Link > Microsoft Excel Chart Object
Paste > Keep Source Formatting and Link Data / Use Destination Theme and Link Data
I would late like to use VBA to change the source Excel file. To do this, consider the following code:
Private Sub PrintLinks()
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
Set pptPresentation = ActivePresentation
For Each pptSlide In pptPresentation.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Type = msoChart Or pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedChart Then
Debug.Print pptShape.LinkFormat.SourceFullName
pptShape.LinkFormat.SourceFullName = "PATH/TO/NEW/FILE"
pptShape.LinkFormat.Update
End If
Next
Next
End Sub
This will work for the Paste Link case, but not the Link Data case, in which case pptShape.Type = msoChart. My question is if there is a way to make it work with Link Data as well. Wtih Paste Link, the SourceFullName property will point to a specific chart object, like filename1.xlsx!Chart 1, and changing it to filename2.xlsx!Chart 1 will work as expected. In contrast, under the Link Data option the SourceFullName property only points to filename1.xlsx and I cannot figure out how to see what chart object within the file it is pointing to. Regardless, if I change SourceFullName to filename2.xlsx no error will be thrown, but as far as I can tell the pointer is still to filename1.xlsx, as the chart doesn't change.
I'm trying to fix the hyperlinks in a Word document. I need to change the SubAddress property of some hyperlinks. To that end, I'm looping through them. Unfortunately, I get a very weird error saying method 'subaddress' of object 'hyperlink' failed when I try to change any SubAddress. Apparently this happens because something is broken with VBA itself.
Sub FixHyperlinks()
'
' FixHyperlinks Macro
'
'
ActiveDocument.Hyperlinks(1).SubAddress = "some new subaddress"
End Sub
I'm rocking Office 2016 Professional Plus. Can anybody tell me if this works for you?
It's easy to test. Just create a new document, type two one-word lines. Make the second line style "Heading 1". Go to first line, hit CTRK + K (to create hyperlink) point it to "a place in this document", select the heading you just created. DO NOT enter any address. Now go to Macros, paste the above and hit F5 while your caret is inside the code.
The hyperlink works fine when clicked with the mouse (first line hyperlink will take you to the 2nd line Heading).
Although Hyperlink.SubAddress Property is supposed to be a read/write string, writing to it fails - even in Word 2010. Try something along the lines of:
Dim Rng As Range, StrAddr As String, StrTxt As String
With ActiveDocument
With .Hyperlinks(1)
Set Rng = .Range
StrAddr = .Address
StrTxt = .TextToDisplay
.Delete
End With
.Hyperlinks.Add Anchor:=Rng, Address:=StrAddr, SubAddress:="new_sub_address"
End With
The strangest thing is happening with my macro in Excel. It works like a charm, but when it has to copy 2 charts and paste into my powerpoint presentation, suddenly, the Chart isn't exactly the same.
My code:
Set Wb = Workbooks.Open("Path\WbName.xlsx", ReadOnly:=True, UpdateLinks:=0)
It opens 5 more workbooks... And then it goes through a loop, to copy all the Charts
Dim Charts_Arr As Variant
Charts_Arr = Worksheets("Parameters").ListObjects("Parameters").DataBodyRange.Value
For i = LBound(Charts_Arr) To UBound(Charts_Arr)
SourcePath = Charts_Arr(i, 8)
SheetName = Charts_Arr(i, 4)
ShapeNr = Charts_Arr(i, 2)
SlideNr = Charts_Arr(i, 3)
Schaling = Charts_Arr(i, 6)
Set Source = Workbooks(SourcePath)
Set PPpres = oPPTApp.ActivePresentation
Set Sh = Source.Sheets(SheetName).Shapes(ShapeNr)
Sh.Copy
Set NewSh = PPpres.Slides(SlideNr).Shapes.PasteSpecial(ppPasteJPG)
With NewSh
.Top = Charts_Arr(i, 5)
.Left = Charts_Arr(i, 7)
.ScaleHeight Schaling, msoTrue
End With
Next i
This goes perfectly. But when I take a look at the ppt-file, 2 charts are not exactly the same.
(TIP: Excel is Chartarea, not a shape - didn't know this at first)
When copy the picture manually, I get the correct picture:
And what's more bizarre, I have 2 other Charts on another Sheet in the same workbook who doesn't cause any problems.
Could this be a problem with links, or the way I copy?
UPDATE
If I adjust the code as suggested below:
Source.Sheets(SheetName).ChartObjects(ShapeNr).Chart.CopyPicture
Set NewSh = PPpres.Slides(SlideNr).Shapes.Paste
With NewSh
.Top = Charts_Arr(i, 5)
.Left = Charts_Arr(i, 7)
.ScaleHeight Schaling, msoTrue
End With
I get this:
I'm doing something wrong with the Paste part of the code, I guess.
Tried other possibilities, always end up getting no images, or the one above.
FIXERSUPDATE
So I made/used a loophole. Couldn't find a way to paste the images directly into Powerpoint, So I pasted it into an excelsheet 'Temp' instead. And adjusted the Array, and that seemed to work. But I still would like to know how to do this directly in Powerpoint.
Thanks in advance for your insights!
I couldn't find a PasteSpecial Option that could fix the issue.
CopyasPicture works, but I can't seem to figure out how to paste it directly into ppt. So I used a workaround. I created a 'Temp' Sheet, where I could paste the Chart as Picture in the right format, afterwards I could program it to paste the shape into Ppt. Not the cleanest way to solve the issue, but it works.
I have some very simple code for setting cell A2 to the path/filename in an auto open macro.
Sub Auto_Open()
Dim apath, aname, aref
apath = Workbooks("Workbook.xlsm").Path
aname = Workbooks("Workbook.xlsm").Name
aref = apath & "\" & aname
ActiveWorkbook.Worksheets("Sheet1").Cells(2, 1) = aref
End Sub
The last line fails on my machine, but works on a co-workers machine. The problem is with the Cells object. When I add a watch on the Cells object, it shows the "Application-Defined or object-defined error". It's as if the Cells object doesn't exist. What baffles me is that it works on my co-workers machine.
The workbook does have a couple of other protected worksheets, but Sheet1 is not protected. I get the same issue when I un-protect the other sheets.
I've tried changing the Cells reference to a Range("A2") instead, same behaviour. However, if I set it to point to a different sheet, it works fine!
What is it about this sheet that's stopping me from accessing the Cells/Range property?
I'm trying to write a vba code using the DDE method. The code aims to copy a set of columns of an excel table and paste it in a parametric table in the EES (Engineering Equation Solver) software. Then an EES code is run to solve de table, generating columns of output data. This data is then copied and pasted back in the excel file that contains the input data.
Since I'm new to vba, I've used the example provided by EES (Executing EES Macro Commands from EXCEL) as a guideline.
The problem occurs when the data is pasted back in the excel spreadsheet: the code seems to be neglecting the decimal separator! Both my excel and EES are set to work with the comma as the decimal separator and when I manually copy the results from EES and paste then to excel the number is pasted normally, with the comma (also the numbers from excel are correctly pasted into ESS).
However, when I set the code to perform this task numbers such as "15,47" are pasted in excel as "1,55E+12" or "1547421377050". The code is shown below:
Private Sub cmdDDE_Click()
Dim ChNumber As Integer
Dim myShell As String
ChNumber = -1
myShell = frmEESDDE.txtApp.Text
On Error Resume Next
'Copy selected rows into clipboard
Range("B2:G1401").Select
Selection.Copy
Shell_R = Shell(myShell, 1)
If Shell_R <> "" Then
'Initiate DDE
ChNumber = Application.DDEInitiate(app:="ees", topic:="")
If ChNumber <> -1 Then
'Open EES
Application.DDEExecute ChannelNumber, "[Open C:\EES\Tablesolve.ees]"
'Paste data
Application.DDEExecute ChannelNumber, "[Paste Parametric 'Table 1' R1 C1]"
'Solve parametrictable
Application.DDEExecute ChannelNumber, "[SOLVETABLE 'TABLE 1' Rows=1..1400]"
'Copy results
Application.DDEExecute ChannelNumber, "[COPY ParametricTable 'Table 1' R1 C7:R1400 C14]"
'Choose separators
Application.DecimalSeparator = ","
Application.ThousandsSeparator = "."
Application.UseSystemSeparators = False
'Paste results from EES into EXCEL
Application.Paste Destination:=Worksheets("Sheet1").Range("H2:O1440")
Application.UseSystemSeparators = True
'Quit EES and Terminate DDE
DDEExecute ChNumber, "QUIT"
Application.DDETerminate ChNumber
Else
MsgBox "Unable to initiate connection to EES", vbExclamation, "EES DDE"
End If
frmEESDDE.Hide
Else
MsgBox "The application, " & myShell & ", was not found", vbExclamation, "EES DDE"
End If
PS = As you can see I've tried to set the decimal separator to "," as suggested in this link: Pasting decimal numbers in excel / comma and point decimal separator but it didn't work either!
I appreciate your help!
Problem solved!
I also posted the question in the portuguese speaking community of stackoverflow and got a very helpful answer. With little adjustments it solved my problem!
The link to the solution in portuguese follows:
https://pt.stackoverflow.com/questions/74860/vba-excel-n%C3%A3o-reconhece-v%C3%ADrgula-de-dados-externos
But for those who would prefer the english version I'll try to summarize what was done to fix the code:
1- declare range variables:
Dim interval As Range 'represent the cells in which info was pasted
Dim Cell As Range 'to allow cell format to be changed
2- after copying the results from the esternal program and before pasting:
Set interval = Worksheets("Sheet1").Range("H2:O1440") 'set interval to paste the results
interval.NumberFormat = "#" 'set format to text
3- after pasting:
interval.NumberFormat = "General" 'set format to general
For Each Cell In interval
Cell.Value = FormatNumber(CDbl(Cell.Value), 2) 'set only 2 decimal places
Cell.Value = CDbl(Cell.Value) 'set to double
Next
The rest of the code stays as it is.
Special thanks to Cantoni who helped with the solution in the pt version.
Instead of pasting with application.paste, try to paste only the values. ie: Instead of
Application.Paste Destination:=Worksheets("Sheet1").Range("H2:O1440")
Use
Range("H2:O1440").PasteSpecial xlPasteValues
If that doesn't work, parse the output as a string.
You can also try this:
Worksheets("Sheet1").Range("H2").PasteSpecial xlPasteValuesAndNumberFormats