![](/img/trans.png)
[英]How to attach a excel workbook to slide in power point using vba
[英]Unable to set position of an object in power point through excel using vba
我目前正在使用Mac 2011的excel宏。宏的目标是复制图表并在PowerPoint幻灯片中进行调整。 但是,每当我尝试使用.Left属性设置位置时,都会将该属性的值重置为零。 我不为什么我那样做。 也许是因为我使用的是Mac版本。 但我似乎找不到与我有同样问题的人。 如果出现错误,或者至少尝试找到解决方法,您能否帮助我更正我正在使用的代码? 我感谢你们的任何帮助。
这是我的代码:
Option Explicit
Sub Presentation()
Application.ScreenUpdating = False
'Variable
Dim i As Integer
Dim tot As Integer
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.slide
Dim cht As Excel.ChartObject
Dim tbl As Range
Dim sChart As Chart
tot = InputBox("Saisir le nombre de slide voulu : ", "Nombre de Slides")
i = 1
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Create a power point
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Create presentation
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
'Show presentation
newPowerPoint.Visible = True
'Loops through each worksheet named 1 , 2 ...
While i <= tot
'Activate the i worksheet
Worksheets(CStr(i)).Activate
'Add a slide
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Get title
activeSlide.Shapes(1).TextFrame.TextRange.Text = Range("A1").Value
'Ajust title position
activeSlide.Shapes(1).Left = 0
activeSlide.Shapes(1).Top = 0
'Loops through each charts in the sheet
For Each cht In ActiveSheet.ChartObjects
cht.Select
'Copie/Colle le graphique
ActiveChart.ChartArea.Copy
activeSlide.Shapes.Paste.Select
'Ajust the chart's position to bottom right
With newPowerPoint.ActiveWindow.Selection.ShapeRange
.Align msoAlignRights, msoTrue
.Align msoAlignBottoms, msoTrue
End With
Next
'Copy / Paste the range
Set tbl = ActiveSheet.Range("B1").CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Copy
With activeSlide.Shapes.Paste
'HERE'S THE PROBLEM
.Width = 300 'The value of width is now set to 0 instead of 300
.Height = 300 'The value of height is now set to 0 instead of 300
.Left = 720 'The value of left is now set to 0 instead of 720
.Top = 888 'The value of top is now set to 0 instead of 888
End With
i = i + 1
Wend
Application.ScreenUpdating = True
AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing
End Sub
请帮助我,我似乎找不到任何解决方法,如果我不太清楚,请原谅我,因为我是法语,英语不是我的自然语言。
提前致谢
尝试这个:
'paste
activeSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set activeSlideShapeRange = activeSlide.Shapes(activeSlide.Shapes.Count)
'position:
activeSlide.Left = 234
activeSlide.Top = 186
'empty clipboard
Application.CutCopyMode = False
HTH
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.