Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Excel2ppt / 4 сообщений из 4, страница 1 из 1
21.10.2006, 16:26:55
    #34071857
Ivan33
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel2ppt
надстройка. берет лист экселя и как картинку пихает в паверпойнт.
...
Рейтинг: 0 / 0
21.10.2006, 16:29:33
    #34071858
Ivan33
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel2ppt
...
Рейтинг: 0 / 0
21.10.2006, 16:34:50
    #34071860
Ivan33
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel2ppt
...
Рейтинг: 0 / 0
08.11.2006, 10:18:27
    #34111092
Ivan33
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel2ppt
отседова

пример кода из статьи

автор Paste Selected Embedded Charts onto the Active PowerPoint Slide
This procedure copies each selected embedded chart in the active worksheet as a picture, then pastes it onto the active slide in the active PowerPoint presentation.





Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
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

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
    oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Excel2ppt / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]