can you convert tables present in word to excel?? Regards kunal
On Apr 10, 11:44 am, hari kumar <[email protected]> wrote: > Hi Raghu, > > Select the charts and run the below macro. > Please let me know if there are any problems. > > Sub CopyChartsIntoPowerPoint() > ''' COPY SELECTED EXCEL CHARTS INTO POWERPOINT > ' Set a VBE reference to Microsoft PowerPoint Object Library > > Dim pptApp As PowerPoint.Application > Dim iShapeIx As Integer, iShapeCt As Integer > Dim myShape As Shape, myChart As ChartObject > Dim bCopied As Boolean > > Set 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 > Next > Else > ''' CHART ELEMENT OR SINGLE CHART IS SELECTED > Set myChart = ActiveChart.Parent > bCopied = CopyChartToPowerPoint(pptApp, myChart) > End If > > Dim myPptShape As PowerPoint.Shape > Dim myScale As Single > Dim iShapesCt As Integer > > ''' BAIL OUT IF NO PICTURES ON SLIDE > On Error Resume Next > iShapesCt = pptApp.ActiveWindow.Selection.SlideRange.Shapes.Count > If Err Then > MsgBox "There are no shapes on the active slide", vbCritical, "No > Shapes" > Exit Sub > End If > On Error GoTo 0 > > ''' ASK USER FOR SCALING FACTOR > myScale = 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, msoTrue, msoScaleFromMiddle > End With > End If > Next > > Set myChart = Nothing > Set myShape = Nothing > Set myPptShape = Nothing > Set pptApp = Nothing > End Sub > > Sub CopyChartsIntoPowerPoint() > ''' COPY SELECTED EXCEL CHARTS INTO POWERPOINT > ' Set a VBE reference to Microsoft PowerPoint Object Library > > Dim pptApp As PowerPoint.Application > Dim iShapeIx As Integer, iShapeCt As Integer > Dim myShape As Shape, myChart As ChartObject > Dim bCopied As Boolean > > Set 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 > Next > Else > ''' CHART ELEMENT OR SINGLE CHART IS SELECTED > Set myChart = ActiveChart.Parent > bCopied = CopyChartToPowerPoint(pptApp, myChart) > End If > > Dim myPptShape As PowerPoint.Shape > Dim myScale As Single > Dim iShapesCt As Integer > > ''' BAIL OUT IF NO PICTURES ON SLIDE > On Error Resume Next > iShapesCt = pptApp.ActiveWindow.Selection.SlideRange.Shapes.Count > If Err Then > MsgBox "There are no shapes on the active slide", vbCritical, "No > Shapes" > Exit Sub > End If > On Error GoTo 0 > > ''' ASK USER FOR SCALING FACTOR > myScale = 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, msoTrue, msoScaleFromMiddle > End With > End If > Next > > Set myChart = Nothing > Set myShape = Nothing > Set myPptShape = Nothing > Set pptApp = Nothing > End Sub > > > > On Thu, Apr 9, 2009 at 2:34 AM, <[email protected]> wrote: > > > Hi All, > > > Please find the attachment. > > > My requirements is – > > > Can anyone tell me how to pull the charts from the excel file to the > > PPT? I want two charts to be placed in ONE PPT. For example – Chart 1 > > & Chart 2 should go to PPT Slide 1 and Chart 3 & Chart 4 should go PPT > > Slide 2 and likewise. I want it be placed centrally. > > > I have to update lots of Charts to update in the PPT from excel file > > every month and its very annoying to copy and paste one by one and > > consumes lots of time. PLEASE HELP. > > > Regards, > > Raghu J. > > -- > Hari kumar --~--~---------~--~----~------------~-------~--~----~ ------------------------------------------------------------------------------------- Some important links for excel users: 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at http://www.excelitems.com 2. Excel tutorials at http://www.excel-macros.blogspot.com 3. Learn VBA Macros at http://www.vbamacros.blogspot.com 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to [email protected] If you find any spam message in the group, please send an email to: Ayush Jain @ [email protected] or Ashish Jain @ [email protected] ------------------------------------------------------------------------------------- -~----------~----~----~----~------~----~------~--~---
