Макрос для переноса диаграм и таблиц из 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>
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д