Макрос для переноса диаграм и таблиц из execl в powerpoint - VB
Формулировка задачи:
Есть Execl файл, в нём таблицы и диаграммы. Нужно что бы с помощью макроса, таблицы и диаграммы переносились в PowerPoint нажатием на кнопку. Тоесть автоматическое создание презентации. Я ещё только начинающий программер в VBA.
Решение задачи: «Макрос для переноса диаграм и таблиц из execl в powerpoint»
textual
Листинг программы
<font color="blue">Option</font> <font color="blue">Explicit</font>
<font color="00AA00">' Импортирует все графики в презентацию</font>
<font color="blue">Dim</font> counter <font color="blue">As</font> <font color="blue">Long</font>
<font color="blue">Sub</font> ImportGraphsFromCloseFile()
<font color="blue">Dim</font> fileName <font color="blue">As</font> <font color="blue">String</font>
<font color="blue">Dim</font> i
<font color="blue">Dim</font> xlApp <font color="blue">As</font> <font color="blue">Object</font>
<font color="blue">Dim</font> xlWorkbook <font color="blue">As</font> <font color="blue">Object</font>
<font color="blue">Dim</font> xlSheet <font color="blue">As</font> <font color="blue">Object</font>
<font color="blue">Dim</font> nm <font color="blue">As</font> <font color="blue">Object</font>
<font color="00AA00">' тут ничего лучшего не предумал, т.к. для корректной работы макроса нужно, чтобы</font>
<font color="00AA00">' курсор стоял именно на слайде а не там где превьюшки</font>
<font color="00AA00">' поэтому на всякий случа передёргиваю режим</font>
<font color="blue">With</font> Application.ActiveWindow
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.ViewType = ppViewNormal
<font color="blue">End</font> <font color="blue">With</font>
<font color="blue">Set</font> xlApp = CreateObject(<font color="teal">"Excel.Application"</font>)
fileName = xlApp.GetOpenFilename(<font color="teal">"Excel Files (*.xls), *.xls"</font>)
<font color="blue">If</font> fileName Like <font color="teal">""</font> <font color="blue">Then</font>
MsgBox (<font color="teal">"Выберите файл для импортирования данных"</font>)
<font color="blue">Else</font>
xlApp.Workbooks.<font color="blue">Open</font> (fileName)
<font color="blue">Set</font> xlWorkbook = xlApp.ActiveWorkbook
xlApp.Visible = True
counter = <font color="darkblue"><b>1</b></font>
<font color="blue">For</font> <font color="blue">Each</font> xlSheet <font color="blue">In</font> xlWorkbook.Sheets
<font color="blue">If</font> xlSheet.<font color="blue">Name</font> Like <font color="teal">"Диаграмма*"</font> <font color="blue">Then</font>
xlSheet.ChartArea.Copy
PasteGraphs
<font color="blue">Else</font>
<font color="blue">If</font> xlSheet.ChartObjects.Count > <font color="darkblue"><b>0</b></font> <font color="blue">Then</font>
<font color="blue">For</font> i = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> xlSheet.ChartObjects.Count
xlSheet.ChartObjects(i).Chart.ChartArea.Copy
PasteGraphs
<font color="blue">Next</font>
<font color="blue">End</font> <font color="blue">If</font>
<font color="blue">For</font> <font color="blue">Each</font> nm <font color="blue">In</font> xlSheet.Names
<font color="blue">If</font> nm.<font color="blue">Name</font> Like <font color="teal">"*таблица*"</font> <font color="blue">Then</font>
nm.RefersToRange.Copy
PasteGraphs
<font color="blue">End</font> <font color="blue">If</font>
<font color="blue">Next</font>
<font color="blue">End</font> <font color="blue">If</font>
<font color="blue">Next</font>
<font color="blue">End</font> <font color="blue">If</font>
<font color="blue">Set</font> xlWorkbook = <font color="blue">Nothing</font>
xlApp.Quit
<font color="blue">Set</font> xlApp = <font color="blue">Nothing</font>
<font color="blue">End</font> <font color="blue">Sub</font>
<font color="blue">Sub</font> PasteGraphs()
ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).<font color="blue">Select</font>
ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
<font color="00AA00">' изменение размера вставленного объекта</font>
<font color="blue">With</font> ActiveWindow.Selection.ShapeRange
.ScaleWidth <font color="darkblue"><b>1</b></font>.<font color="darkblue"><b>2</b></font>, msoFalse, msoScaleFromBottomRight
.ScaleHeight <font color="darkblue"><b>1</b></font>.<font color="darkblue"><b>2</b></font>, msoFalse, msoScaleFromBottomRight
.ScaleWidth <font color="darkblue"><b>1</b></font>.<font color="darkblue"><b>2</b></font>, msoFalse, msoScaleFromTopLeft
.ScaleHeight <font color="darkblue"><b>1</b></font>.<font color="darkblue"><b>2</b></font>, msoFalse, msoScaleFromTopLeft
<font color="blue">End</font> <font color="blue">With</font>
counter = counter + <font color="darkblue"><b>1</b></font>
<font color="blue">End</font> <font color="blue">Sub</font>