Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.68/298: Рейтинг темы: голосов - 298, средняя оценка - 4.68
БурундукЪ
9556 / 2557 / 83
Регистрация: 17.02.2009
Сообщений: 10,364
1

Статьи, FAQ

22.05.2009, 20:02. Просмотров 53828. Ответов 1
Метки нет (Все метки)

Как определить последнюю запись в таблице Excel?
Q: Необходимо найти последнюю запись вэлектронной таблице. Какой функцией VB это можно было бы организовать.
A: Первое что вспомнилось: Application.SpecialCells(xlLastCell)

Как отменить выделение диапазона ячеек?
Q: Как управиться с такой болячкой:
Visual Basic
1
ActiveSheet.Cells.Select
После прекращения работы макроса диапазон остается выделенным. Как это выделение убрать?
A: Попробуй вот как:
Visual Basic
1
Selection.Cells(1).Select
Фокус ввода попадёт после этого на первую ячейку ранее выделенного диапазона.

Как из макроса Excel программно создать таблицу Access?
Q: Подскажите, пожалуйста, как из под Excel программно создать таблицу Access
A: Вот фрагмент кода, который создаёт таблицу "BalanceShifr" базе данных MS Access:
Нint: Не забудьте выставить в Excel ссылки на объекты DAO!
Tools/References/Available References/
MicroSoft DAO?.? Library
Visual Basic
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
' Function CreateTable
' Create temporary table "BalanceShifr" into temporary database
Public Function CreateTable(ByVal dbTemp As Database) As Boolean
Dim tdfTemр As TableDef
Dim idx As Index
Dim fld As Field
On Error GoTo errhandle
  CreateTable = True
  '  CREATE TABLE "BalanceShifr"
  Set tdfTemp = dbTemp.CreateTableDef("BalanceShifr")
  Set fld = tdfTemp.CreateField("ConditionId", dbLong)
  fld.Required = True
  tdfTemp.Fields.Append fld
  Set fld = tdfTemp.CreateField("Account", dbText, 4)
tdfTemp.Fields.Append fld
  Set fld = tdfTemp.CreateField("SubAcc", dbText, 4)
  tdfTemp.Fields.Append fld
  Set fld = tdfTemp.CreateField("Shifr", dbLong)
  tdfTemp.Fields.Append fld
  Set fld = tdfTemp.CreateField("Date", dbDate)
fld.Required = True
  tdfTemp.Fields.Append fld
  Set fld = tdfTemp.CreateField("SaldoDeb", dbCurrency)
  tdfTemp.Fields.Append fld
  Set fld = tdfTemp.CreateField("SaldoKr", dbCurrency)
  tdfTemp.Fields.Append fld
  dbTemp.TableDefs.Append tdfTemp
 
  '  CREATE INDEX "BalanceShifr"
  Set tdfTemp = dbTemp.TableDefs("BalanceShifr")
  Set idx = tdfTemp.CreateIndex("ForeignKey")
  Set fld = idx.CreateField("ConditionId")
  idx.Fields.Append fld
  tdfTemp.Indexes.Append idx
  Exit Function
 
errHandle:
  MsgBox "Table creating error!", vbExclamation, "Error"
  CreateTable = False
End Function

Удаление листов в зависимости от даты
Q: Как удалить рабочие листы листов в зависимости от даты?
A: Вот код функции на Excel VBA, который решает данную проблему:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
' Function DelSheetByDate
' Удаляет рабочий лист sSheetName в активной рабочей книге,
' если дата dDelDate уже наступила
' В случае успеха возвращает True, иначе - False
 
Public Function DelSheetByDate(sSheetName As String, _
 dDelDate As Date) As Boolean
On Error GoTo errHandle
 
  DelSheetByDate = False
  ' Проверка даты
  If dDelDate <= Date Then
   ' Не выводить подтверждение на удаление
   Application.DisplayAlerts = False
   ActiveWorkbook.Worksheets(sSheetName).Delete
   DelSheetByDate = True
   Application.DisplayAlerts = True
 End If
 
Exit Function
errHandle:
  MsgBox Err.Description, vbCritical, "Ошибка №" & Err.Number
End Function

Подавление "горячих" клавиш.
Q:Как подавить доступ по "горячим" клавишам, имеется ввиду предопределенные в Excel клавиши типа Ctrl-O и т.д.?
A:Вот малюсенький исходник на Excel VB, который решает такую проблему. :-)
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Sub Auto_Open()
' Overrride standard accelerators
  With Application
    .OnKey "^o", "Dummy"
    .OnKey "^s", "NewAction"
    .OnKey "^p", ""             ' Kill hotkey !
  End With
End Sub
' -----
Public Sub Dummy()
   MsgBox "This hotkey redefined!"
End Sub
' -----
Public Sub NewAction()
  SendKeys "^n"   ' Press <CTRL>+<s> for create new file
                  ' instead of <CTRL>+<n> !
End Sub

Подсказки к Toolbar
Q: Как сделать к «само нарисованным» кнопочкам на Toolbar’е подсказки? (Ну, те, что после 2-х секунд молчания мышки появляются)
A: Сделать можно вот как: (Пример реализации на Excel’97 VBA )
Visual Basic
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
' Cоздаем тулбар
Рublic Sub InitToolBar()
Dim cmdbarSM As CommandBar
Dim ctlNewBtn As CommandBarButton
  Set cmdbarSM = CommandBars.Add(Name:="MyToolBar", _
  Position:=msoBarFloating, _
  temporary:=True)
  With cmdbarSM
    ' 1) Добавляем кнопку
    Set ctlNewBtn = .Controls.Add(Type:=msoControlButton)
    With ctlNewBtn
     . FaceId = 26
      .OnAction = "OnButton1_Click"
     .TooltipText = "My tooltip message!"
    End With
    ' 2) Добавляем ещё кнопку
    Set ctlNewBtn = .Controls.Add(Type:=msoControlButton)
    With ctlNewBtn
      .FaceId = 44
      .OnAction = "OnButton2_Click"
     .TooltipText = "Another tooltip message!"
    End With
    .Visible = True
  End With
End Sub

Как определить адрес активной ячейки
Q: Как в макросе узнать и использовать текущее положение курсора (не мышиного, естественно)?
A: Очень просто! :-)
Visual Basic
1
ActiveCell.Row и ActiveCell.Column
- покажут координаты активной ячейки.

Подсчет комментариев на рабочем листе
Q: Как узнать есть ли хоть один Notes (комментарий) в рабочем листе, кроме как перебором по всем ячейкам? . Без этого не работает:
A: В Excel'97 эта проблема может быть решена вот как:
Visual Basic
1
2
3
4
5
6
7
 ' Function IsCommentsPresent
 ' Возвращает TRUE, если на активном рабочем листе имеется хотя бы
 ' одна ячейка с комментарием, иначе возвращает FALSE
 '
 Public Function IsCommentsPresent() As Boolean
   IsCommentsPresent = ( ActiveSheet.Comments.Count <> 0 )
 End Function

Подсказки к Toolbar (Excel'95)
Q: Как сделать свой собственный Toolbar с tooltip’ами на кнопках в Excel’95?
A: Вот фрагмент кода для Excel'95, который создаёт toolbar с одной кнопкой с пользовательским tooltiр'ом. Нажатие кнопки приводит к выполнению макроса NothingToDo() .
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
' This example creates a new toolbar, adds the Camera button
' (button index number 228) to it, and then displays the new toolbar.
Public Sub CreateMyToolBar()
Dim myNewToolbar As Toolbar
On Error GoTo errHandle:
  Set myNewToolbar = Toolbars.Add(Name:="My New Toolbar")
  With myNewToolbar
    .ToolbarButtons.Add Button:=228, StatusBar:="Statusbar help string"
    .Visible = True
    With .ToolbarButtons(1)
      .OnAction = "NothingToDo"
     .Name = "My custom tooltiр text!"
    End With
  End With
Exit Sub
errНandle:
  MsgBox "Error number " & Err & ": " & Error(Err)
End Sub
' Toolbar button on action code
Рublic Sub NothingToDo()
  MsgBox "Nothing to do!", vbInformation, "Macro running"
End Sub
Нint: В Excel'97 этот код тоже работает!

Запуск Excel с поиском ячейки
Q: Как запустить Excel, чтобы оказаться на ячейке содержимое которой известно заранее?
A:Вот как я решил бы твою задачу:
Visual Basic
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
' Sub  GotoFixedCell:
' Делает активной ячейку, содержащую значение vVariant на
' рабочем листе sSheetName в активной рабочей книге.
' Note: Содержимое ячеек интерпретируется как 'значение'!
Public Sub GotoFixedCell(vValue As Variant, sSheetName As String)
  Dim c As Range, cStart As Range, cForFind As Range
  Dim i As Integer
  On Error GoTo errhandle:
  Set cForFind = Worksheets(sSheetName).Cells   ' Диапазон поиска
     With cForFind
       Set c = .Find(What:=vValue, After:=ActiveCell, LookIn:=xlValues, _
                LookAt:= xlРart, SearchOrder:=xlByRows,_
                SearchDirection:=xlNext, MatchCase:=False)
       Set cStart = c
       While Not c Is Nothing
         Set c = .FindNext(c)
         If c.Address = cStart.Address Then
           c.Select
           Exit Sub
         End If
       Wend
     End With
  Exit Sub
  errНandle:
    MsgBox Err.Descriрtion, vbExclamation, "Error #" & Err.Number
End Sub
Нint: Достаточно выполнить этот код из макроса Auto_Oрen()!
Нint: Протестировано и отлажено в Excel'97.

ThisWorkBook или ActiveWorkBook?
Q: На листе модулей открытой рабочей книги присутствует процедура, которая копирует некий лист из другой (не активной) рабочей книги. В этом листе в некоторых ячейках находятся определенные пользователем формулы. Процедура работает без проблем.
Из workbook, содержащей эту процедуру, я делаю надстройку (.xla) и подключаю ее к Excel 95. При вызове вышеописанной процедуры она выдает сообщение:
Run time error 424 object required
Kак можно избежать это сообщение?
A:Вот что я тебе посоветую:
Посмотри ещё разок код модулей рабочей книги и исправь все ссылки вида ActiveWorkbook.WorkSheets(".. на ссылки вида ThisWorkBook.WorkSheets("..
Дело в том, что когда выполняется код надстройки активной книгой в Excel'е является _не_ сама надстройка! Конструкция ThisWorkbook позволяет сослаться на книгу, в которой в настоящий момент выполняется код Excel VBA.
Нint: Это общий принцип создание надстроек Excel!

Как задать имя листу, который будет вставлен?
Q:Хочy через Excel VBA задать имя листу, который будет вставлен. Но у команды Sheets.Add нет такого параметра ! Как бороться?
A: Очень просто...
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
' Sub CreateSheet
' Вставляет активную рабочую книгу в рабочий лист с именем sSName.
' Note: Если параметр bVisible имеет значение False, этот лист становится  скрытым.
Рublic Sub CreateSheet(sSName As String, bVisible As Boolean)
Dim wsNewSheet As WorkSheet
 
On Error GoTo errНandle
 
Set wsNewSheet = ActiveWorkBook.Worksheets.Add
  With wsNewSheet
   .Name = sSName
   .Visible = bVisible
  End With
Exit Sub
errНandle:
  MsgBox Err.Descriрtion, vbExclamation, "Error #" & Err.Number
End Sub

Как проверить существует ли лист?
Q: А как проверить существует ли лист?
A: Я бы поступил вот как:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
' Function IsWorkSheetExist
 ' Проверяет, имеется ли в активной рабочей книге лист с именем sSName.
 ' В случае успеха возвращает True, иначе - False
 Рublic Function IsWorkSheetExist(sSName As String) As Boolean
Dim c As Object
 
 On Error GoTo errНandle:
   Set c = sheets(sName)
   ' Альтернативный вариант :
 Worksheets(sSName).Cells(1, 1) = Worksheets(sSName).Cells(1, 1)
   IsWorkSheetExist = True
 Exit Function
 errНandle:
   IsWorkSheetExist = False
 End Function
Нint: Отлажено и протестировано в Excel'97.

Как обратиться к ячейке по ее имени?
Q: Как обратиться к ячейки по ее имени? Т.е. есть Лист1 и в нем ячейки с именем Дебет и Кредит. Хочy подсчитать Дебет-Кредит средствами Excel VBA. Попробовал Range(Дебет)-Range(Кредит), ругается, что не описаны переменные.
A: Если я правильно тебя понял, нужно разыменовать ячейку из кода Excel VBA. Вот фрагмент кода, который решает такую задачу:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
 ' Function ValueOfNamedCell
 ' Возвращает значение ячейки с именем sCellName. в активной рабочей книге.
 ' Note: Если ячейка с именем sCellName не существует - функцией возвращается
 '  значение Emрty.
 Рublic Function ValueOfNamedCell(sCellName As String) As Variant
 On Error GoTo errНandle
   ValueOfNamedCell = ActiveWorkbook.Names(sCellName).RefersToRange.Value
 Exit Function
 errНandle:
   ValueOfNamedCell = Emрty
 End Function
Нint: Отлажено и протестировано в Excel'97.

Можно ли из программы на Visual Basic создать рабочую книгу Excel?
Q: Можно ли из программы на Visual Basic создать рабочую книгу Excel?
A: Да, можно…..
Пример того, как из Visual Basic'a через OLE запустить Excel, и создать рабочую книгу...
Visual Basic
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
' CreateXlBook
' Вызывает MS Excel, создает рабочую книгу с именем sWbName с одним
' единственным рабочим листом. Рабочая книга будет сохранена в каталоге
' sDirName. В случае успеха возвращает True, в противном случае - False.
'
Public Function CreateXlBook(sWbName As String, sDirName) As Boolean
 
  ' MS Excel hidden instance
  Dim objXLApp As Object
  Dim objWbNewBook As Object
 
  CreateXlBook = False
 
  Set objXLApp = CreateObject("Excel.Application")
  If objXLApp Is Nothing Then Exit Function
 
  ' В новой рабочей книге создавать только один рабочий лист
  objXLApp.SheetsInNewWorkbook = 1
 
  Set objWbNewBook = objXLApp.Workbooks.Add
  If objWbNewBook Is Nothing Then Exit Function
 
  ' Сохраняем книгу
  If vbNullString = Dir(sDirName, vbDirectory) Then Exit Function
 
  objWbNewBook.SaveAs (sDirName + "" + sWbName + ".xls")
  CreateXlBook = True
 
  ' Освобождение памяти
  Set objWbNewBook = Nothing
  objXLApp.Quit
  Set objXLApp = Nothing
  CreateXlBook = True
 
End Function
26
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
22.05.2009, 20:02
Ответы с готовыми решениями:

Статьи и литература по VBA на русском языке
Подскажите пожалуйста ссылки Собрался программировать - код из справки не...

Запретить доступ к тому или иному диапазону в зависимости от выбранной статьи
Очень важно ! Прошу помощи! Значит так, у меня есть определенная таблица...

Обсуждение статьи "Как зарегистрировать свой пользовательский ActiveX DLL из клиента"
Хочу обсудить статью из интернета: http://support.microsoft.com/kb/173407/ru ...

Вывод на страницу статьи, списком заголовки всех других статей, за исключением текущей статьи
Здравствуйте, уважаемые программисты! Подскажите пожалуйста, оформляю на...

Чем определяется одинаковость урлов /page?FAQ и /page.php?FAQ
Подскажите, пожалуйста, какая опция php или настройка сервера позволяет не...

1
БурундукЪ
9556 / 2557 / 83
Регистрация: 17.02.2009
Сообщений: 10,364
24.12.2009, 20:20  [ТС] 2
работа с PowerPoint
Работа с PowerPoint из VBA, автоматизация создания презентаций, объекты PowerPoint.Application, PowerPoint.Presentation, PowerPoint.Slide, PowerPoint.Shape

Использовать возможности VBA в PowerPoint на предприятиях приходится намного реже, чем возможности Word или Excel, однако иногда такие потребности возникают. Часто специалисты используют презентации PowerPoint для сопровождения выступлений при демонстрации продуктов или услуг, отчетов о деятельности и т.п. Поскольку со слайдами можно связывать звуковое сопровождение, PowerPoint активно используется для целей обучения — например, подготовки интерактивных уроков. Еще одна часто используемая возможность — создание звуковых книг с картинками для детей. При помощи PowerPoint можно создавать фотоальбомы со звуковым сопровождением, диафильмы со звуком, детские игры и многое другое. И как только данных становится много (а, например, цифровых фотографий редко бывает мало) сразу встает вопрос об автоматизации.

PowerPoint — программа работы с презентациями (то есть наборами графических изображений — слайдов, иногда со звуковым сопровождением). Чаще всего приходится программным способом выполнять следующие действия:

* автоматически создавать презентации (например, на основе набора изображений в каталоге);
* производить обработку презентаций — менять формат изображения, добавлять или изменять аудиосопровождение и т.п. Чаще всего подобные действия приходится производить в тех ситуациях, когда презентации были связаны с внешними файлами и эти файлы изменяются.

В PowerPoint система объектов выглядит следующим образом:

* объект самого высокого уровня — Application, с набором свойств и методов, очень похожим на аналогичные объекты в Word и Excel;
* на уровень ниже — коллекция Presentations с объектами Presentation. Можно сказать, что эти объекты по месту в иерархии примерно аналогичны объекту Workbook в Excel;
* в объект Presentation встроена коллекция Slides с объектами Slide (в качестве примерного аналога можно привести листы в книгах Excel);
* в объект Slide встроена коллекция Shapes с объектами Shape. Объекты Shape представляют все элементы слайда (всего их 22 типа) — изображение, надпись, диаграмма, заголовок, таблица, автофигура и т.п.

Вокруг этих четырех объектов — Application, Presentation, Slide и Shape и строится вся объектная модель PowerPoint.

Проиллюстрирую работу с PowerPoint на примерах из реальной жизни.

Предположим, что нам нужно создать презентацию PowerPoint на основе набора JPG-картинок, которые будут лежать в каталоге C:\Slides (например, они получены со сканера или цифрового фотоаппарата). Имена файлов JPG идут по порядку, например, с DSCN2440.JPG по DSCN2480.JPG. Файлов в каталоге может быть переменное количество, поэтому нам нужно взять все файлы, которые есть в этом каталоге. Наша задача — поместить их в презентацию по порядку. Задача усугубляется тем, что JPG-файлы разного размера (по высоте и ширине), а слайды, конечно, желательно сделать одинаковыми.

Как ни удивительно, код VBA для PowerPoint удобнее запускать не из PowerPoint, а из внешнего приложения, поддерживающего VBA, например, Word или Excel. Так на момент запуска у нас гарантированно не будет активных презентаций и мы ничего не перепутаем с точки зрения вставки.

Как может выглядеть наше решение:

Создаем новый документ в Word или Excel, в него помещаем кнопку или обеспечиваем другой графический интерфейс по вкусу. Главное — не забыть добавить в проект ссылки на две объектные библиотеки:

* Microsoft PowerPoint 11.0 Object Library (C:\Program Files\Microsoft Office\Office 11\msppt.olb) — для объектов самого PowerPoint;
* Microsoft Scripting Runtime (C:\Windows\System32\ScrRun.dll) — для того , чтобы можно было пользоваться объектом FileSystemObject и прочими для работы с файловой системой . Эта библиотека, которая есть на любом компьютере начиная с Windows 2000, — самый удобный способ выполнения большинства действий в файловой системе.

Далее можно приступать к созданию кода.

Конечно, первое, что нам потребуется — запустить PowerPoint. Делается это точно так же, как и для Word, Excel, Access и т.п.:

Visual Basic
1
2
3
4
5
Dim oApp As New PowerPoint.Application
 
oApp.Activate
 
oApp.Visible = msoTrue
Следующее действие — нужно создать новую пустую презентацию:

Visual Basic
1
2
3
Dim oPresent As PowerPoint.Presentation
 
Set oPresent = oApp.Presentations.Add()
Все абсолютно стандартно, как будто мы создаем новый документ Word. А вот дальше начинаются моменты, специфические для PowerPoint и нашей задачи

Следующим действием должно быть создание слайда. Но нам придется создать столько слайдов, сколько файлов находится в каталоге C:\Slides. Конечно же, нужно создавать слайды в цикле. Вначале мы получаем (при помощи библиотеки Scripting Runtime (можно было бы обойтись и средствами Office, но так проще) коллекцию всех файлов этого каталога:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim oFSO As New Scripting.FileSystemObject
 
Dim oFolder As Scripting.Folder
 
Dim oFile As Scripting.File
 
 
Set oFolder = oFSO.GetFolder("C:\Slides")
 
For Each oFile In oFolder.Files
 
…
 
Next
Если мы вместо многоточия поставим строку, например такого вида:

Visual Basic
1
MsgBox oFile.Name
то можно будет убедиться, что набор файлов в правильном порядке мы получили.

Далее нам все-таки нужно создать слайды. Делается это при помощи метода Add() коллекции Slides. В документации к русскому PowerPoint 2003 описание этого метода по непонятной причине отсутствует (даже несмотря на то, что справка по VBA все равно на английском), но из всплывающей подсказки можно догадаться, что этот метод хочет принимать два параметра (обязательных): номер слайда в презентации, который должен начинаться с 1, и одно из значений перечисления ppSlideLayout (из нескольких десятков), которое определяет шаблон слайда.

Номер слайда придется обеспечивать счетчиком, а наилучший для нас шаблон — пустой:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Dim nCounter As Integer
 
nCounter = 1
 
For Each oFile In oFolder.Files
 
Set oSlide = oApp.ActivePresentation.Slides.Add(nCounter, ppLayoutBlank)
 
…
 
nCounter = nCounter + 1
 
Next
А теперь — самое главное: вставляем в слайд изображение и настраиваем его размеры. Для этой цели можно использовать метод AddPicture() коллекции Shapes каждого слайда:

Visual Basic
1
2
3
4
5
oSlide.Shapes.AddPicture FileName:="C:\Slides\" & _
 
oFile.Name, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
 
Left :=10, Top :=10, Width :=700, Height :=520
Параметр FileName — это, конечно, имя передаваемого файла. Именно он и будет меняться в цикле. LinkToFile — этот параметр определяет, будет ли файл изображения помещен внутрь презентации ( msoFalse) или в презентацию будет помещена на него ссылка (msoTrue). Конечно, если вставляемые файлы не очень большие, то и с точки зрения удобства, и с точки зрения производительности презентации лучше поместить их внутрь презентации (файла PPT). Параметр SaveWithDocument, конечно, определяет, сохранять ли наши изображения вместе с презентацией (в нашем случае сохранять). А Left, Top, Width и Height нужны, чтобы сделать изображения одинакового размера (чтобы подобрать нужные значения, я занимался обычным подбором по методу "недолет-перелет").

Естественно, код этого пункта помещается вместо многоточия в цикл. Чтобы не возиться с удалением обработанных файлов, я поместил в цикл еще одну очевидную строку:

Visual Basic
1
oFile.Delete
Итоговый код для нашей задачи может выглядеть так:

Visual Basic
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
Dim oApp As New PowerPoint.Application
 
oApp.Activate
 
oApp.Visible = msoTrue
 
 
 
Dim oPresent As PowerPoint.Presentation
 
Set oPresent = oApp.Presentations.Add()
 
 
 
Dim oFSO As New Scripting.FileSystemObject
 
Dim oFolder As Scripting.Folder
 
Dim oFile As Scripting.File
 
 
 
Set oFolder = oFSO.GetFolder("C:\Slides")
 
For Each oFile In oFolder.Files
 
Set oSlide = oApp.ActivePresentation.Slides.Add(nCounter, ppLayoutBlank)
 
oSlide.Shapes.AddPicture FileName:="C:\Slides\" & _
 
oFile.Name, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
 
Left:=10, Top:=10, Width:=700, Height:=520
 
oFile.Delete
 
Next
Несколько строк кода могут заменить часы нудной работы по копированию и вставке изображений вручную.

На практике работа с PowerPoint может быть достаточно сложной при работе с эффектами анимации, звуковым сопровождением, диапазонами фигур и т.п. Найти в документации то, что вам будет нужно, не так-то просто. Рекомендуется для получения "наводящих указаний" активнее использовать макрорекордер и анализировать созданный им код. Однако макрорекордер часто выбирает какие-то очень нетривиальные способы выполнения различных действий. Например, для вставки того же рисунка он предлагает использовать код типа

Visual Basic
1
ActiveWindow.Selection.SlideRange.Shapes.AddPicture …
что, конечно, задачу не упрощает. Так что код макрорекордера всегда рекомендуется проверять и исправлять.


Коллекция Projects , объект Project и вложенные объекты
Объекты Project, Task, Resource, работа с проектами на Project Server из VBA, корпоративный пул ресурсов

После того, как объект Application создан (а значит, Projeсt открыт — программно или вручную), нам нужно создать или открыть в нем проект.

Создание проекта может выглядеть очень просто, при помощи метода Add() коллекции Projects:

Visual Basic
1
2
3
Dim oProj As Project
 
Set oProj = Projects.Add()
Дополнительные необязательные параметры метода Add() позволяют создать новый проект на основе шаблона или открыть окно для выбора шаблонов.

Если нужно открыть существующий проект, то нам может встретиться два варианта этой задачи:

* Нужно открыть локальный проект (из файла *. mpp).

Здесь все просто :

Visual Basic
1
Application.FileOpen ("D:\Project1.mpp")
А затем ловим объектную ссылку на этот проект (поскольку сам метод FileOpen() нам ее не возвращает):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
For Each Project In Application.Projects
 
If Project.Name = "project1.mpp" Then
 
Set oProj = Project
 
Exit For
 
End If
 
Next
 
MsgBox oProj.Name
Нужно открыть проект с сервера Project Server. Здесь все выполняется точно так же, за исключением того, что мы используем метод FileOpen() с параметром с хитрым синтаксисом:

Visual Basic
1
Application . FileOpen ("<>\Забор.Опубликовано")
"<>\Забор.Опубликовано" — это, конечно, имя проекта на сервере Project Server. К этому серверу мы должны подключиться в момент запуска Project. При этом при запуске Project указать сервер, к которому мы подключаемся, не получится. Придется идти сильно в обход: работать с коллекцией Profiles объекта Application, который позволяет просмотреть профили, создать новый профиль, настроить параметры подключения (путь к серверу, имя и тип учетной записи), сделать его профилем по умолчанию и т.п. Например, если мы работаем из внешнего приложения, можно создать нужный профиль, сделать его профилем по умолчанию, подключиться к Project Server — а потом вернуть все обратно. Но чаще все-таки пользователь автоматически при входе подключается к Project Server и заниматься нам этим не нужно.

Такой же синтаксис ("<>\Забор.Опубликовано") можно будет использовать и потом, при сохранении проекта на Project Server (методом SaveAs() объекта Project).

После того, как мы создали проект, можно работать с его элементами — задачами, ресурсами и назначениями.

Добавление задачи в проект может выглядеть так:
Visual Basic
1
2
Dim oTask As Task
Set oTask = oProj.Tasks.Add("Задача 1")
У объекта Task огромное количество свойств, которые позволяет настроить любые параметры задачи. Например, у этого объекта есть свойство ActualStart, ActualFinish, ActualDuration и т.п. Но догадаться, как каждое из этих свойств соотносится с нужным нам полем на графическом экране, очень сложно. Обычно намного удобнее после создания задачи использовать не ее свойства, а специальный метод SetTaskField объекта Application. Отличие этого метода — в том, что он принимает в качестве параметров имя свойства (на русском — так, как оно выглядит на графическом экране), значение, и в качестве одного из необязательных параметров — TaskId. Например, начало и длительность созданной нами задачи можно установить так:

Visual Basic
1
2
3
Application.SetTaskField "Начало", Date, False, False, oTask.ID
 
Application.SetTaskField "Длительность", "2д", False, False, oTask.ID
В принципе, средствами этого метода можно сразу создавать задачи, но это обычно не самый удобный способ.

Есть возможность также просто после настройки нужного параметра на графическом экране сохранить проект в XML (или получить его в XML cредствами Project Data Services — об этом ниже) и посмотреть информацию о настроенных параметрах элементов.

Другой важный элемент любого проекта — ресурсы. Работа с ресурсами включает в себя несколько задач.

Первая задача — работа с корпоративным пулом ресурсов. Заполнение корпоративного пула, отслеживание изменений в нем и обеспечение актуальности — один из самых трудоемких компонентов работы с Project Server. Часто информацию о ресурсах нужно синхронизировать с внешними источниками данными (обычно с базами данных). Это можно сделать средствами Project Data Services, а можно — средствами VBA. Открыть корпоративный пул ресурсов можно так:

Application.EnterpriseResourcesOpen EUID :="", OpenType := pjReadWrite

Если передать этому методу значения всех параметров (они необязательные), то глобальный корпоративный пул ресурсов будет открыт без каких-либо диалоговых окон. Далее обычным способом (указанным выше) ловим объектную ссылку на проект, имя которого — "Извлеченные корпоративные ресурсы" и создаем в нем ресурсы, а потом сохраняем и закрываем. Другая возможность — импортировать ресурсы в глобальный корпоративный пул при помощи специального метода Application.EnterpriseResourcesImport(), которому передается ID локального ресурса.

Другая задача — создать локальные ресурсы. Здесь все просто. В объекте Project предусмотрена коллекция Resources с методом Add(), которая состоит из объектов ресурсов. Единственная проблема — то, что свойств у ресурсов тоже очень много. Но на помощь нам приходит метод SetResourceField(), аналогичный уже рассмотренному:

Visual Basic
1
2
3
4
5
6
7
8
9
Dim oRes As Resource
 
Set oRes = oProj.Resources.Add("Иванов Иван")
 
Application.SetResourceField "Тип", "Трудовой", False, False, oRes.ID
 
Можно, конечно, использовать и стандартные свойства объекта:
 
oRes.StandardRate = 100
Разновидность этой задачи — поместить в локальный проект ресурсы из корпоративного пула. Для этой цели проще всего использовать метод Application.EnterpriseResourceGet(), которому нужно передать ID глобального ресурса и ID локального ресурса. Предварительно ID глобального ресурса можно получить, пройдя по нему циклом и выбрав нужные ресурсы по значению определенных полей.

Следующая задача обычно — произвести назначения. Это можно сделать множеством разных способов:

* первый способ — воспользоваться коллекцией Assignments и ее метод Add():
Visual Basic
1
oTask.Assignments.Add oTask.ID, oRes.ID
* второй способ — применить метод Application.ResourceAssignment() . Он хорош тем, что позволяет назначать ресурсы одновременно нескольким задачам, но эти задачи должны быть выделены (пользователем или программным способом, что снижает надежность этого метода)
* третий способ — воспользоваться уже знакомым нам методом SetTaskField():

Visual Basic
1
SetTaskField Field :="Названия ресурсов", Value :="Иванов Иван[100%]"
Последнее, о чем нужно поговорить — о назначении настраиваемых кодов структуры и корпоративных полей. Если обязательный настраиваемый корпоративный код структуры для проекта, задачи или ресурса не определен, то проект просто нельзя будет сохранить на сервере. Настраиваемые коды структуры и корпоративные поля настраиваются как обычные свойства. Если для задач и ресурсов они доступны напрямую (например, oRes.EnterpriseText1 = "Мой текст"), а для проекта — через свойство SummaryTask:

Visual Basic
1
ActiveProject.ProjectSummaryTask.EnterpriseCost1 = "500.00"
5
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.12.2009, 20:20

Как анонс статьи убрать из статьи?)
Допустим написал я статью, использовал тег More, мне нужно что-бы все что до...

С++11 и С++14 FAQ
На сайте http://isocpp.org/ был опубликован анонс нового C++ FAQ. Материал...

FAQ
Не могу скачать документацию...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru