Макрос для переноса диаграм и таблиц из 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>

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 4.25 из 5
Похожие ответы