VBA粘贴选定Excel嵌入式图表到当前PowerPoint幻灯片中

概述VBA粘贴选定Excel嵌入式图表到当前PowerPoint幻灯片中

下面是内存溢出 jb51.cc 通过网络收集整理的代码片段。

内存溢出小编现在分享给大家，也给大家做个参考。

Sub copyChartsIntopowerPoint()''' copY SELECTED EXCEL CHARTS INTO POWERPOINT' Set a VBE reference to Microsoft PowerPoint Object libraryDim pptApp As PowerPoint.ApplicationDim iShapeIx As Integer,iShapeCt As IntegerDim myShape As Shape,myChart As ChartObjectDim bcopIEd As BooleanSet pptApp = Getobject(,"PowerPoint.Application")If ActiveChart Is nothing Then    ''' SELECTION IS NOT A SINGLE CHART    On Error Resume Next    iShapeCt = Selection.ShapeRange.count    If Err Then        MsgBox "Select charts and try again",vbCritical,"nothing Selected"        Exit Sub    End If    On Error GoTo 0    For Each myShape In Selection.ShapeRange        ''' IS SHAPE A CHART?        On Error Resume Next        Set myChart = ActiveSheet.ChartObjects(myShape.name)        If Not Err Then            bcopIEd = copyCharttopowerPoint(pptApp,myChart)        End If        On Error GoTo 0    NextElse    ''' CHART ELEMENT OR SINGLE CHART IS SELECTED    Set myChart = ActiveChart.Parent    bcopIEd = copyCharttopowerPoint(pptApp,myChart)End IfDim myPptShape As PowerPoint.ShapeDim myScale As SingleDim iShapesCt As Integer''' BAIL OUT IF NO PICTURES ON SLIDEOn Error Resume NextiShapesCt = pptApp.ActiveWindow.Selection.SlIDeRange.Shapes.countIf Err Then    MsgBox "There are no shapes on the active slIDe","No Shapes"    Exit SubEnd IfOn Error GoTo 0''' ASK USER FOR SCAliNG FACTORmyScale = inputBox(Prompt:="Enter a scaling factor for the shapes (percent)",_    Title:="Enter Scaling Percentage") / 100''' LOOP THROUGH SHAPES AND RESCALE "PICTURES"For Each myPptShape In pptApp.ActiveWindow.Selection.SlIDeRange.Shapes    If myPptShape.name like "Picture*" Then        With myPptShape            .ScaleWIDth myScale,msoTrue,msoScaleFromMIDdle            .ScaleHeight myScale,msoScaleFromMIDdle        End With    End IfNextSet myChart = nothingSet myShape = nothingSet myPptShape = nothingSet pptApp = nothingEnd SubFunction copyCharttopowerPoint(oPPtApp As PowerPoint.Application,_    oChart As ChartObject)copyCharttopowerPoint = FalseoChart.Chart.copyPicture Appearance:=xlScreen,Format:=xlPicture,Size:=xlScreenoPPtApp.ActiveWindow.VIEw.PastecopyCharttopowerPoint = TrueEnd Function

以上是内存溢出(jb51.cc)为你收集整理的全部代码内容，希望文章能够帮你解决所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。

总结

以上是内存溢出为你收集整理的VBA粘贴选定Excel嵌入式图表到当前PowerPoint幻灯片中全部内容，希望文章能够帮你解决VBA粘贴选定Excel嵌入式图表到当前PowerPoint幻灯片中所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。