ReSQL.ru
     
powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Макрос для переноса диаграм и таблиц из execl в powerpoint
49 сообщений из 49, показаны все 2 страниц
  все  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34797496
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Есть Execl файл, в нём таблицы и диаграммы. Нужно что бы с помощью макроса, таблицы и диаграммы переносились в PowerPoint нажатием на кнопку. Тоесть автоматическое создание презентации. Я ещё только начинающий программер в VBA.
...
Рейтинг: 0 / 0
13.09.2007, 13:37
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34799270
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Если получится, то поделись. (на мыло или на форум)
Немного эгоистично, но вещь нужная, а разбираться некогда.
Сейчас делаю так. Есть файл Эксель, в котором нарисованы все шаблоны диаграмм и таблиц на каждом листе ровно на печатную страницу. Есть файл ПоверПоинт, в котором связанные ссылки на все печатные диапазоны файла Эксель. Таким образом нужно только обновить данные в Экселе, потом открыть Повер, зайти в правка - связи, выделить все и нажать обновить и все связи обновятся. Причём удобно, что при отправке такая презентация содержит только рисунки диаграмм, в то время как при обычном копировании из Эксель Диаграммы вместе с ней в Презентацию подвязывается весь файл Эксель и его потом можно открыть двойным щелчком по диаграмме.
...
Рейтинг: 0 / 0
13.09.2007, 22:09
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34799610
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Вот что сочинил мой приятель. Поиск и вставка диаграмм идёт по отдельным листам. А мне надо чтобы поиск шёл в листе где находятся таблицы и диаграммы.
Sub ImportGraphs()
'Dim xlApp As Excel.Application
Dim counter As Integer
Dim fileName As String

Dim xlApp As Object
Dim xlWorkbook As Object
Set xlApp = CreateObject("Excel.Application")

fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")

If fileName Like "" Then
MsgBox ("Выберите файл для импортирования данных")
Else
xlApp.Workbooks.Open (fileName)

Set xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True

counter = 1

For counter = 1 To xlWorkbook.Sheets.Count
If xlWorkbook.Sheets(counter).Name Like "Диаграмма*" Then
xlWorkbook.Sheets(counter).ChartArea.Copy
ActivePresentation.Slides(counter).Select
ActiveWindow.View.Paste
End If
Next
End If

Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
...
Рейтинг: 0 / 0
14.09.2007, 08:38
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34801679
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Вот немного потделал

Option Explicit

Sub ImportGraphs()
Dim counter As Integer
Dim fileName As String
Dim i

Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")

fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")

If fileName Like "" Then
MsgBox ("Âûáåðèòå ôàéë äëÿ èìïîðòèðîâàíèÿ äàííûõ")
Else
xlApp.Workbooks.Open (fileName)

Set xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True

counter = 1

For Each xlSheet In xlWorkbook.Sheets

If xlSheet.Name Like "Äèàãðàììà*" Then
xlSheet.ChartArea.Copy
ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
counter = counter + 1
Else

If xlSheet.ChartObjects.Count > 0 Then

For i = 1 To xlSheet.ChartObjects.Count
xlSheet.ChartObjects(i).Chart.ChartArea.Copy
ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
counter = counter + 1
Next

End If

End If
Next

End If

Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
...
Рейтинг: 0 / 0
14.09.2007, 16:49
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34801682
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Код: 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.
Option Explicit

Sub ImportGraphs()
Dim counter As Integer
Dim fileName As String
Dim i

Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")

fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")

If fileName Like "" Then
MsgBox ("Выберите файл для импортирования данных")
Else
xlApp.Workbooks.Open (fileName)

Set xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True

counter =  1 

For Each xlSheet In xlWorkbook.Sheets
 
  If xlSheet.Name Like "Диаграмма*" Then
      xlSheet.ChartArea.Copy
      ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
      ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
      counter = counter +  1 
    Else
     
     If xlSheet.ChartObjects.Count >  0  Then
       
       For i =  1  To xlSheet.ChartObjects.Count
         xlSheet.ChartObjects(i).Chart.ChartArea.Copy
         ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
         ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
         counter = counter +  1 
       Next
     
     End If
     
   End If
Next

End If

Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
...
Рейтинг: 0 / 0
14.09.2007, 16:49
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34801762
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Даже так
Option Explicit
' Импортирует все графики в презентацию
Dim counter As Long
Sub ImportGraphs()
Dim fileName As String
Dim i

Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")

fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")

If fileName Like "" Then
MsgBox ("Выберите файл для импортирования данных")
Else
xlApp.Workbooks.Open (fileName)

Set xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True

counter = 1

For Each xlSheet In xlWorkbook.Sheets
If xlSheet.Name Like "Диаграмма*" Then
xlSheet.ChartArea.Copy
PasteGraphs
Else
If xlSheet.ChartObjects.Count > 0 Then
For i = 1 To xlSheet.ChartObjects.Count
xlSheet.ChartObjects(i).Chart.ChartArea.Copy
PasteGraphs
Next
End If

End If
Next

End If

Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub

Sub PasteGraphs()

ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue

' изменение размера вставленного объекта
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 1.2, msoFalse, msoScaleFromBottomRight
.ScaleHeight 1.2, msoFalse, msoScaleFromBottomRight
.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
End With

counter = counter + 1

End Sub
...
Рейтинг: 0 / 0
14.09.2007, 17:08
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34801765
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Да шо за нах...
DeggasadДаже так
Код: 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.
Option Explicit
' Импортирует все графики в презентацию
Dim counter As Long
Sub ImportGraphs()
Dim fileName As String
Dim i

Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")

fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")

If fileName Like "" Then
MsgBox ("Выберите файл для импортирования данных")
Else
xlApp.Workbooks.Open (fileName)

Set xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True

counter =  1 

For Each xlSheet In xlWorkbook.Sheets
  If xlSheet.Name Like "Диаграмма*" Then
      xlSheet.ChartArea.Copy
      PasteGraphs
    Else
     If xlSheet.ChartObjects.Count >  0  Then
       For i =  1  To xlSheet.ChartObjects.Count
         xlSheet.ChartObjects(i).Chart.ChartArea.Copy
         PasteGraphs
       Next
     End If
     
   End If
Next

End If

Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub

Sub PasteGraphs()
         
   ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
   ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
        
   ' изменение размера вставленного объекта
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth  1 . 2 , msoFalse, msoScaleFromBottomRight
        .ScaleHeight  1 . 2 , msoFalse, msoScaleFromBottomRight
        .ScaleWidth  1 . 2 , msoFalse, msoScaleFromTopLeft
        .ScaleHeight  1 . 2 , msoFalse, msoScaleFromTopLeft
    End With
    
    counter = counter +  1 

End Sub


З.ы.:
Модератору: удалите пожалуйста мои сообщения котоые не обрамлены кодом
...
Рейтинг: 0 / 0
14.09.2007, 17:09
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34802707
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Прилагаю файл с переделанными вариантами на всякий случай
...
Рейтинг: 0 / 0
15.09.2007, 16:42
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34802713
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Но самое главное спасибо PlayerP за то, что он подтокнул меня сделать, то, на что я давно не решался, а хотелось. Вообщем кому нужно выкладываю пример процедуры, которая предлагает выбрать один из открытых файлов, выбирает из этих файлов области печати со всех листов, на которых присвоены области печати и вставляет их как связанные объекты в Презентацию добавляя при этом слайды по порядку.
Предполагается что пользователь заблаговременно задал области печати размером примерно на альбомный печатный лист на всех листах которые хотел перенести в презентацию, а также убрал на них сетку и разметку страниц дабы не портить внешний вид слайда.

Буду рад предложениям и улучшениям, возможно новым идеям
...
Рейтинг: 0 / 0
15.09.2007, 16:53
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34802850
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
К концу дня появились обновления!
Всякие проверки там и полезности, типа ввода первого номера слайда, выравнивание размера, вообщем кому надо - пользуйтесь, по крайней мере для примера. 3-4 месяца назад я бы многое за такой примерчик отдал бы (ну да это чувствас).
...
Рейтинг: 0 / 0
15.09.2007, 20:08
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34803988
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Deggasad ты гений!
Но есть не большие проблемы. В файле Excel я указал несколько областей печати, запустил макрос и, и не работает. То есть не вставляет указанные области печати в отдельные листы презентации. Deggasad как сделать так чтобы указанные области печати вставлялись в отдельные листы презентации???
...
Рейтинг: 0 / 0
17.09.2007, 10:03
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34804314
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
1) проверте действительно ли вы задали области печати (лучше всего их задавать с помощью меню файл - область печати задать), тогда у вас должен появиться диапазон область печати в раскрывающемся списке адресов, как в прилагаемом рисунке.

2) Возможно увас этот диапазон будет называться по другому, наприер если у вас английский Эксель, то он наверное будет называться "Print_Area"
В этом случае замените в строке кода
Код: plaintext
            xlSheet.Range("Область_печати").Copy
имя "Область_печати" на ваше имя. Я даже думаю, что в любом случае попробуйте подставить "Print_Area", возможно поможет (у меня нет других версий эксель чтобы попробовать).
...
Рейтинг: 0 / 0
17.09.2007, 11:31
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34805157
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Deggasad дела в том что если я указываю 1 область печати то данная область вставляться в PowerPoint, но если я добавляю область печати, макрос перестаёт работать и при этом пишет что он всё импортировал, а лист остался пустой в презентации.
...
Рейтинг: 0 / 0
17.09.2007, 14:51
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34805172
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Не пойму, может файл выложите который не хочет импортироваться.
...
Рейтинг: 0 / 0
17.09.2007, 14:54
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34805183
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
DeggasadНе пойму, может файл выложите который не хочет импортироваться.
Только с вашими областями, которые вы добавили
...
Рейтинг: 0 / 0
17.09.2007, 14:56
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34805597
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Этот файл не могу выложить, чревато последствиями для меня.
...
Рейтинг: 0 / 0
17.09.2007, 16:31
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34805650
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPЭтот файл не могу выложить, чревато последствиями для меня.

Что же блин так сложно всегда.
Ну неужели вы не можете создать файл с 3-мя листами попробовать воспроизвести своё горе на этих трёх листах, так чтобы поменьше весил файл, но при этом была понятна ваша проблема. То есть ваши секреты мне не нужны, как раз наоборот я не собираюсь качать Мегафайл мегабайт в 20. Нужен короткий пример с абстракными данными, который наглядно иллюстрирует что у вас не получается. Или вы не хотите напрягаться делать такой пример?
...
Рейтинг: 0 / 0
17.09.2007, 16:43
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34805923
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Вот абстрактный пример (смотрите вложение). Нужно чтобы таблицы и диаграммы импортировалась в презентацию.
...
Рейтинг: 0 / 0
17.09.2007, 17:44
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34806150
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Я же просил изобразить твои попытки, а ты скинул две диаграммы - на мол, как будто одолжение сделал.
Короче, я выкладываю как бы сделал я, если использовать предложенную мной идею. Один лист экселя - это один слайд. Таким образом на каждом листе мы создаём всё что нужно слайду на одной странице с альбомной ориентацией и желательно 100% масштабом (это чтобы не путаться), т.е. сдесь пишем название, делаем и размещаем по слайду диаграмки, таблички, надписи, автофигуры. Задаём область печати ровно на одну страницу (меню файл - область печати - задать), не забываем убрать сетку с листа или сделать нужную заливку и выйти из режтма разметки страницы а то полосы синие на слайде будут. И это всё попторяем для всех листов - слайдов, при этом на листах может находится сколько угодно вспомогательных данных главное чтобы они не попадали в область печати. А потом запускаем макрос, который я последним прилагал и он должен выбрать со свех листов выбранной книги области печати листов-слайдов и связать их со слайдами презентации. При изменении в файле Эксель данных, можно просто обновить все связи в презентации.
...
Рейтинг: 0 / 0
17.09.2007, 18:47
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34806179
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
А чтобы просто выбрать все диаграммы и поместить на слайды, я там где-то раньше решение прилагал! - просто дорабатывать не стал, так как посчитал менее интересным.
...
Рейтинг: 0 / 0
17.09.2007, 18:54
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34806182
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
DeggasadА чтобы просто выбрать все диаграммы и поместить на слайды, я там где-то раньше решение прилагал! тут ссылка была :) - просто дорабатывать не стал, так как посчитал менее интересным.
...
Рейтинг: 0 / 0
17.09.2007, 18:55
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34806191
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Извени я просто тебя не понял. Вот именно мне нужно что бы таблицы и диаграммы брались с одного листа. Иначе предаться переделывать основной файл. А он очень большой, иметься виду много таблиц и диаграмм.
...
Рейтинг: 0 / 0
17.09.2007, 18:59
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34806268
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPИзвени я просто тебя не понял. Вот именно мне нужно что бы таблицы и диаграммы брались с одного листа. Иначе предаться переделывать основной файл. А он очень большой, иметься виду много таблиц и диаграмм.

Моё мнение такое что всё равно с этим где-то работать. Не разберёшь и не упорядочишь в экселе, придётся возится в поинте. Но это тебе уже решать.

Вариант для диаграмм я уже давал, осталось пробежаться по таблицам. Целесообразно наверное дать всех нужным таблицам имена, например (Лист1!таблица1 , Лист1!таблица2 ... , Лист5!таблица10), Это вставка - имя - присвоить или просто набисать в окошке где адрес ячейки пишется. Потом пробегаться по всем именам в файле и если в нём присутствует слово таблица, то копируем его.
Вот пока писал пост решил по быстрому реализовать. только не забывайте перед именами название листов указывать, а то не будут имена выбираться

Код: 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.
78.
79.
80.
Option Explicit
' Импортирует все графики в презентацию
Dim counter As Long
Sub ImportGraphsFromCloseFile()
Dim fileName As String
Dim i

Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim nm As Object

' тут ничего лучшего не предумал, т.к. для корректной работы макроса нужно, чтобы
' курсор стоял именно на слайде а не там где превьюшки
' поэтому на всякий случа передёргиваю режим
With Application.ActiveWindow
  ActiveWindow.ViewType = ppViewSlide
  ActiveWindow.ViewType = ppViewNormal
End With

Set xlApp = CreateObject("Excel.Application")

fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")

If fileName Like "" Then
MsgBox ("Выберите файл для импортирования данных")
Else
xlApp.Workbooks.Open (fileName)

Set xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True

counter =  1 

For Each xlSheet In xlWorkbook.Sheets
  If xlSheet.Name Like "Диаграмма*" Then
      xlSheet.ChartArea.Copy
      PasteGraphs
    Else
     If xlSheet.ChartObjects.Count >  0  Then
       For i =  1  To xlSheet.ChartObjects.Count
         xlSheet.ChartObjects(i).Chart.ChartArea.Copy
         PasteGraphs
       Next
     End If
       
       For Each nm In xlSheet.Names
         If nm.Name Like "*таблица*" Then
          nm.RefersToRange.Copy
          PasteGraphs
         End If
       Next
       

     
   End If
Next

End If

Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub

Sub PasteGraphs()
         
   ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
   ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
        
   ' изменение размера вставленного объекта
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth  1 . 2 , msoFalse, msoScaleFromBottomRight
        .ScaleHeight  1 . 2 , msoFalse, msoScaleFromBottomRight
        .ScaleWidth  1 . 2 , msoFalse, msoScaleFromTopLeft
        .ScaleHeight  1 . 2 , msoFalse, msoScaleFromTopLeft
    End With
    
    counter = counter +  1 

End Sub
...
Рейтинг: 0 / 0
17.09.2007, 19:28
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34832237
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Вот мой вариант вставления таблиц м диаграмм. Пока конечно в сыром виде, но я над этим работаю.
Возник вопрос, как сделать так что бы презентация создавалась на готовом шаблоне.
...
Рейтинг: 0 / 0
27.09.2007, 17:18
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34834518
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Очередная редакция.
...
Рейтинг: 0 / 0
28.09.2007, 13:33
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34834746
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPОчередная редакция.
Тема продолжается!
Скачал, может вечером дома посмотрю, будут идеи напишу.
...
Рейтинг: 0 / 0
28.09.2007, 14:12
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34836742
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Кусок который за копирование отвечает можно немного оптимизировать. посмотри может что пригодится.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
    Do While Not Application.Worksheets("Список слайдов").Cells(count,  4 ) = ""
       'Создаёт новый слайд
       Range(Worksheets("Список слайдов").Cells(count,  4 ).Value).Copy
        
       With pPpt.Slides.Add(x, ppLayoutBlank).Shapes
       
         .PasteSpecial ppPasteOLEObject, , , , , msoTrue
         
         'Вставляем общий заголовок
         .AddLabel(msoTextOrientationHorizontal,  20 ,  20 ,  200 ,  40 ). _
             TextFrame.TextRange.Text = Worksheets("Список слайдов").Cells( 1 ,  1 ).Value
         'Вставляем заголовок страницы
         .AddLabel(msoTextOrientationHorizontal,  20 ,  100 ,  200 ,  40 ). _
             TextFrame.TextRange.Text = Worksheets("Список слайдов").Cells(count,  4 ).Value
        End With
        x = x +  1 
        count = count +  1 
    Loop
...
Рейтинг: 0 / 0
30.09.2007, 02:06
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34837673
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Deggasad привет. Подскажи пожалуйста как мне задать координаты "ppPasteOLEObject" вставляемого объекта. По умолчанию он вставляется в середину листа.
И ещё, как мне придать общему заголовку шрифт и цвет шрифта?
...
Рейтинг: 0 / 0
01.10.2007, 10:47
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34838786
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Вот посмотри, а вообще открывай ПоверПоинт и через запись макроса пробуй-эксперементируй

Код: 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.
    Do While Not Application.Worksheets("Список слайдов").Cells(count,  4 ) = ""
       'Создаёт новый слайд
       Range(Worksheets("Список слайдов").Cells(count,  4 ).Value).Copy
        
       With pPpt.Slides.Add(x, ppLayoutBlank)
          
            .Shapes.PasteSpecial ppPasteOLEObject, , , , , msoTrue
            ' определение положения первого объекта
            With .Shapes( 1 )
                .Left =  25 
                .Top =  40 
                .Width =  675 
                '.Height = 460
            End With

            'Вставляем общий заголовок
            With .Shapes.AddLabel(msoTextOrientationHorizontal,  20 ,  20 ,  200 ,  40 ).TextFrame.TextRange
               .Text = Worksheets("Список слайдов").Cells( 1 ,  1 ).Value
               With .Font
                  .Size =  14 
                  .Name = "Times New Roman"
                  .Color.RGB = RGB(Red:= 0 , Green:= 51 , Blue:= 204 )
               End With
            End With
            'Вставляем заголовок страницы
            With .Shapes.AddLabel(msoTextOrientationHorizontal,  20 ,  100 ,  200 ,  40 ).TextFrame.TextRange
               .Text = Worksheets("Список слайдов").Cells(count,  4 ).Value
               With .Font
                  .Size =  14 
                  .Name = "Times New Roman"
                  .Color.RGB = RGB(Red:= 0 , Green:= 51 , Blue:= 204 )
               End With
            End With
            
       End With
       x = x +  1 
       count = count +  1 
    Loop
...
Рейтинг: 0 / 0
01.10.2007, 16:01
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34838980
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Deggasad спасибо!!! Есть продолжение темы но я пока не знаю как её воплотить в реальность. Я с начало сам подумаю если что то, Deggasad ты поможешь мне???
...
Рейтинг: 0 / 0
01.10.2007, 17:14
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34839227
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPDeggasad ты поможешь мне???

ну и вопрос, даже не знаю что ответить! всё будет зависеть от вопроса, наличия времени и т.д...
Или ты хочешь чтобы я пообещал ...
...
Рейтинг: 0 / 0
01.10.2007, 18:47
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34839831
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Deggasad: Обещаний никаких не надо, это был вопрос, а не просьба.
...
Рейтинг: 0 / 0
02.10.2007, 09:04
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34839869
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPDeggasad: Обещаний никаких не надо, это был вопрос, а не просьба.

Лучше ближе к делу...
Выкладывай код, будем обсуждать, если получится
...
Рейтинг: 0 / 0
02.10.2007, 09:33
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34841612
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
RC1 Смотрите вложения
...
Рейтинг: 0 / 0
02.10.2007, 17:00
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34842574
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPRC1 Смотрите вложения

Есть какие-то конкретные вопросы?

Вот например при работе с именами правильнее пользоваться коллекцией имён, хотя кому как больше нравится.
Вот посмотрите заполнение ЛистБокса

Код: plaintext
1.
2.
3.
4.
5.
Private Sub UserForm_Initialize()
  Dim iName As Name
   For Each iName In ActiveWorkbook.Names
        UserForm1.ListBox1.AddItem iName.Name
   Next
End Sub
...
Рейтинг: 0 / 0
03.10.2007, 08:25
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34844724
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Как сделать выгрузку из ListBox в Эксель например в лист 1???
...
Рейтинг: 0 / 0
03.10.2007, 17:31
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34844972
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPКак сделать выгрузку из ListBox в Эксель например в лист 1???

Либо так, либо я не понял

Код: plaintext
1.
2.
3.
  Dim i As Long
  For i =  1  To ListBox1.ListCount
       Sheets("Лист1").Range("G" & i).Value = ListBox1.List(i -  1 )
  Next
...
Рейтинг: 0 / 0
03.10.2007, 19:13
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34951242
PlayerP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlayerP
Гость
Deggasad, привет. Как расширить вставляемую таблицу по ширине слайда? Чего то мне не сообразить ка это сделать. Посмотри в моём случае таблицу №6, она всегда вставляется маленькой.
...
Рейтинг: 0 / 0
20.11.2007, 11:42
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34952480
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
PlayerPDeggasad, привет. Как расширить вставляемую таблицу по ширине слайда? Чего то мне не сообразить ка это сделать. Посмотри в моём случае таблицу №6, она всегда вставляется маленькой.

Скачал, вечером дома посмотрю.
...
Рейтинг: 0 / 0
20.11.2007, 15:54
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #34970303
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Лучше поздно чем никогда.
Например вместо
Код: plaintext
1.
2.
3.
4.
5.
        If sPpt.Shapes( 1 ).Width > maxW Then
           sPpt.Shapes( 1 ).Width = maxW
        End If
        If sPpt.Shapes( 1 ).Height > maxH Then
           sPpt.Shapes( 1 ).Height = maxH
        End If
Написать
Код: plaintext
1.
2.
3.
4.
        sPpt.Shapes( 1 ).Width = maxW
        sPpt.Shapes( 1 ).Height = maxH
        If sPpt.Shapes( 1 ).Width > maxW Then
           sPpt.Shapes( 1 ).Width = maxW
        End If
...
Рейтинг: 0 / 0
27.11.2007, 23:25
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #35464085
ZhukElena
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZhukElena
Гость
Уважаемый Deggasad!
Я усердно скоприровала ваш макрос для импорта из открытого экселя, но он у меня не работает- выдает ошибки, я думаю из-за 2007 версии паверпойнта. Помогите блондинке:) Файлик с ошибками приложила
...
Рейтинг: 0 / 0
31.07.2008, 18:14
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #36591300
VanMail
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VanMail
Гость
Здравствуйте Deggasad.
Почему то все макросы стопорятся на этой строке:
ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
если оставить
ActiveWindow.View.Paste
что то ещё выполняется, но не во всех макросах. Может это зависит от версии поинта и екселя, у меня 2007 и 2010. И это не только в моих файлах, но и в тех что скачал с сайта.
И там, и там макросы на этой строке останавливаются. Поиск ppPasteOLEObject ничего не дал, чтобы почитать, понять причину и сделать какие то исправления.
...
Рейтинг: 0 / 0
21.04.2010, 23:23
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #36974652
Maikl 5
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Maikl 5
Гость
Deggasad, доброго времени суток.
Подкажите, как избавиться от видимых ячеек, что бы в Power Point вставлять только график, таблицу.

Спасибо.
...
Рейтинг: 0 / 0
24.11.2010, 15:52
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #36978205
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Maikl 5,
Если просто избавиться от сетки - то убрать сетку в экселе на нужных листах, если нужно именно сами диаграммы вставлять, то у меня был пример в начале раздела как это делать.
...
Рейтинг: 0 / 0
26.11.2010, 08:57
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #36978215
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
VanMailЗдравствуйте Deggasad.
Почему то все макросы стопорятся на этой строке:
ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
если оставить
ActiveWindow.View.Paste
что то ещё выполняется, но не во всех макросах. Может это зависит от версии поинта и екселя, у меня 2007 и 2010. И это не только в моих файлах, но и в тех что скачал с сайта.
И там, и там макросы на этой строке останавливаются. Поиск ppPasteOLEObject ничего не дал, чтобы почитать, понять причину и сделать какие то исправления.

У меня нет 2007 или 2010, поэтому не могу проверить, но вы сами можете включить запись макроса в поинте, скопировать в экселе определенную область и в поинте нажать правка - специальная вставка - связать и ОК, посмотреть что получится в записи макроса и помейте строку именно с копированием.
...
Рейтинг: 0 / 0
26.11.2010, 09:04
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #36978219
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
ZhukElena,

у меня 2003 офис, ноуты под рукой все рабочие с ПО лицензионным, дома не живу сейчас толком, так что придется вам самим дорабатывать или обновить вопрос и попросить других форумчан переделать на 2007 или еще лучше протестировать чтобы на любом работало
...
Рейтинг: 0 / 0
26.11.2010, 09:07
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #37979278
Andemki
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Andemki
Гость
Переделал PowerPoint презентацию так чтобы она работала с Вордом. Т.е. каждую страницу документа помещала на отдельный слайд (отправляю то что получилось, в ворде надо добавить в конце документа пустую страницу, чтобы всё скопировалось). А теперь вопрос: можно ли сделать чтобы таблицы с Ворда копировались в PowerPoint не через специальную вставку как связанный объект Ворда, а как нормальная таблица PowerPoint? Тоже самое с графиками, но их можно копировать как рисунки. Важно только, чтобы таблицы были автономно редактируемы и исходный документ Ворда был не нужен. Если можно, напишите пожалуйста как.
Большое спасибо!
...
Рейтинг: 0 / 0
01.10.2012, 20:07
| Ответить | Цитировать | Написать  
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #37979282
Andemki
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Andemki
Гость
Прошлый файл неправильно открывается, добавил в архив rar (rarr->rar)
...
Рейтинг: 0 / 0
01.10.2012, 20:12
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Макрос для переноса диаграм и таблиц из execl в powerpoint
    #38559226
Valery222
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Valery222
Гость
Deggasad,

Помогите, пожалуйста, создать макрос, чтобы из Excel можно было бы перенести таблицу в презентацию Power Point. Первый раз имею дело с макросом, поэтому надеюсь на понимание)
...
Рейтинг: 0 / 0
13.02.2014, 01:48
| Ответить | Цитировать | Написать  
49 сообщений из 49, показаны все 2 страниц
  все  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Макрос для переноса диаграм и таблиц из execl в powerpoint
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?all=1&fid=60&tid=2156517]:
 0ms
get settings:
 8ms
get forum list:
 11ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 27ms
get topic data:
 10ms
get forum data:
 3ms
get page messages:
 62ms
get tp. blocked users:
 1ms
others: 11ms
total:  141ms
созд. / загр.: 141ms
x
x
Закрыть


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