Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Задать дату в Excel для макроса в Power Point - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Задать дату в Excel для макроса в Power Point
Slym1349 Дата: Вторник, 21.04.2020, 16:09 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Господа, доброго времени суток!
Столкнулся с определенной проблемой в VBA Power Point и вновь обращаюсь к Вам.

Есть макрос в Power Point который при выполнении ищет данные в папках, отталкиваясь от того какая сегодня дата.
Стоит задача убрать привязку к дате и сделать ручной ввод даты.
Проблема в том что дат там много и у всех разный формат. (Input Box не подходит)

В Excel данную проблему я решил через запись

[vba]
Код
Windows ("file.xlsm").Activate
Sheets("Sheet1").Select
new_date = Range("AE35").Value
[/vba]

При такой же вставке получил ошибку

Compile error: Sub or function not defined

В общем то ожидаемо. :(

Подскажите пожалуйста какую "оговорку" сделать в коде чтобы Power Point мог брать дату из соответствующей ячейки Excel?

С уважением, Slym

P.S. Код не выделяю через #, т.к. почему то криво отображается в теме...


Сообщение отредактировал Slym1349 - Вторник, 21.04.2020, 16:13
 
Ответить
СообщениеГоспода, доброго времени суток!
Столкнулся с определенной проблемой в VBA Power Point и вновь обращаюсь к Вам.

Есть макрос в Power Point который при выполнении ищет данные в папках, отталкиваясь от того какая сегодня дата.
Стоит задача убрать привязку к дате и сделать ручной ввод даты.
Проблема в том что дат там много и у всех разный формат. (Input Box не подходит)

В Excel данную проблему я решил через запись

[vba]
Код
Windows ("file.xlsm").Activate
Sheets("Sheet1").Select
new_date = Range("AE35").Value
[/vba]

При такой же вставке получил ошибку

Compile error: Sub or function not defined

В общем то ожидаемо. :(

Подскажите пожалуйста какую "оговорку" сделать в коде чтобы Power Point мог брать дату из соответствующей ячейки Excel?

С уважением, Slym

P.S. Код не выделяю через #, т.к. почему то криво отображается в теме...

Автор - Slym1349
Дата добавления - 21.04.2020 в 16:09
Pelena Дата: Среда, 22.04.2020, 08:26 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19410
Репутация: 4560 ±
Замечаний: ±

Excel 365 & Mac Excel
Есть макрос

покажете?

почему то криво отображается в теме

Выделяем код и нажимаем #. Всё работает, исправила


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Есть макрос

покажете?

почему то криво отображается в теме

Выделяем код и нажимаем #. Всё работает, исправила

Автор - Pelena
Дата добавления - 22.04.2020 в 08:26
Slym1349 Дата: Среда, 06.05.2020, 13:47 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Извините за долгий ответ :)

Смотрите сам макрос Power Point'a запускается из файла Excel, вот так:

[vba]
Код
Dim objPP As Object
Dim objPPFile As Object

Set objPP = CreateObject("PowerPoint.Application")
objPP.Visible = True

Path = "  "

Set objPPFile = objPP.Presentations.Open("C:\путь\" presentation.pptm")          
Application.EnableEvents = False
objPP.Run "presentation.pptm!Daily.Dates_Copies_PDF"                    '

Application.EnableEvents = True
'objPPFile.Close
Set objPPFile = Nothing
Set objPP = Nothing

End Sub
[/vba]

В этой части привязку к ручному вводу даты можно задать без проблем.
В макросе Power Point же привязка к дате идет следующим образом:

[vba]
Код
...
' Для понедельника и вторника

If Weekday(Date) = 2 Or Weekday(Date) = 3 Or Weekday(Date) = 4 Then
    a = Format(Date - 5, "DD.MM.YYYY")
    b = Format(Date - 5, "YYYYMMDD")
    c = Format(Date, "DD.MM.YYYY")
    d = Format(Date - 5, "YYMMDD")
    e = Format(Date - 5, "YYYY")
    f = Format(Date - 5, "YYYY_MM")
    g = Format(Date - 5, "MM")
    Z = "год"

' Для среды, четверга и пятницы

Else
    a = Format(Date - 3, "DD.MM.YYYY")
    b = Format(Date - 3, "YYYYMMDD")
    c = Format(Date, "DD.MM.YYYY")
    d = Format(Date - 3, "YYMMDD")
    e = Format(Date - 3, "YYYY")
    f = Format(Date - 3, "YYYY_MM")
    g = Format(Date - 3, "MM")
    Z = "год"

End If

...
[/vba]

Сам макрос вставлять не буду - там идут команды на изменение строк на слайдах, вставку новых слайдов и т.д.
Пути к слайдам и даты в строках задаются вышеуказанными переменными.

Если нужно я конечно укажу его целиком, просто он большой + придется менять все пути т.к. на работе строго с безопасностью.

Вот.
Собственно вопрос в том как отвязать даты от функции Date и задавать их таблицей в Excel.

Т.к. все даты отчетности строго по рабочим дням и в Excel можно настроить трудовой календарь, а функции Date безразлично выходной сейчас день или нет.

С уважением, Slym
 
Ответить
СообщениеИзвините за долгий ответ :)

Смотрите сам макрос Power Point'a запускается из файла Excel, вот так:

[vba]
Код
Dim objPP As Object
Dim objPPFile As Object

Set objPP = CreateObject("PowerPoint.Application")
objPP.Visible = True

Path = "  "

Set objPPFile = objPP.Presentations.Open("C:\путь\" presentation.pptm")          
Application.EnableEvents = False
objPP.Run "presentation.pptm!Daily.Dates_Copies_PDF"                    '

Application.EnableEvents = True
'objPPFile.Close
Set objPPFile = Nothing
Set objPP = Nothing

End Sub
[/vba]

В этой части привязку к ручному вводу даты можно задать без проблем.
В макросе Power Point же привязка к дате идет следующим образом:

[vba]
Код
...
' Для понедельника и вторника

If Weekday(Date) = 2 Or Weekday(Date) = 3 Or Weekday(Date) = 4 Then
    a = Format(Date - 5, "DD.MM.YYYY")
    b = Format(Date - 5, "YYYYMMDD")
    c = Format(Date, "DD.MM.YYYY")
    d = Format(Date - 5, "YYMMDD")
    e = Format(Date - 5, "YYYY")
    f = Format(Date - 5, "YYYY_MM")
    g = Format(Date - 5, "MM")
    Z = "год"

' Для среды, четверга и пятницы

Else
    a = Format(Date - 3, "DD.MM.YYYY")
    b = Format(Date - 3, "YYYYMMDD")
    c = Format(Date, "DD.MM.YYYY")
    d = Format(Date - 3, "YYMMDD")
    e = Format(Date - 3, "YYYY")
    f = Format(Date - 3, "YYYY_MM")
    g = Format(Date - 3, "MM")
    Z = "год"

End If

...
[/vba]

Сам макрос вставлять не буду - там идут команды на изменение строк на слайдах, вставку новых слайдов и т.д.
Пути к слайдам и даты в строках задаются вышеуказанными переменными.

Если нужно я конечно укажу его целиком, просто он большой + придется менять все пути т.к. на работе строго с безопасностью.

Вот.
Собственно вопрос в том как отвязать даты от функции Date и задавать их таблицей в Excel.

Т.к. все даты отчетности строго по рабочим дням и в Excel можно настроить трудовой календарь, а функции Date безразлично выходной сейчас день или нет.

С уважением, Slym

Автор - Slym1349
Дата добавления - 06.05.2020 в 13:47
Slym1349 Дата: Среда, 20.05.2020, 12:24 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Вариантов нет?)
 
Ответить
СообщениеВариантов нет?)

Автор - Slym1349
Дата добавления - 20.05.2020 в 12:24
Pelena Дата: Среда, 20.05.2020, 17:24 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19410
Репутация: 4560 ±
Замечаний: ±

Excel 365 & Mac Excel
Вариант может быть такой:
-- для первого слайда рисуем надпись, но рисуем не на слайде, а за пределами, скажем выше или правее, т.е при демонстрации она не будет видна
-- можно назвать её как-то, например DateExcel
-- из макроса Excel в эту надпись отправляем содержимое ячейки типа
[vba]
Код
objPPFile.Slides(1).Shapes("DateExcel").TextFrame.TextRange.Text = Sheets(1).Range("A1").Value
[/vba]
-- в макросе PowerPoint считываем дату из этой надписи
[vba]
Код
a = Format(CDate(Slide1.Shapes("DateExcel").TextFrame.TextRange.Text) - 5, "DD.MM.YYYY")
[/vba]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеВариант может быть такой:
-- для первого слайда рисуем надпись, но рисуем не на слайде, а за пределами, скажем выше или правее, т.е при демонстрации она не будет видна
-- можно назвать её как-то, например DateExcel
-- из макроса Excel в эту надпись отправляем содержимое ячейки типа
[vba]
Код
objPPFile.Slides(1).Shapes("DateExcel").TextFrame.TextRange.Text = Sheets(1).Range("A1").Value
[/vba]
-- в макросе PowerPoint считываем дату из этой надписи
[vba]
Код
a = Format(CDate(Slide1.Shapes("DateExcel").TextFrame.TextRange.Text) - 5, "DD.MM.YYYY")
[/vba]

Автор - Pelena
Дата добавления - 20.05.2020 в 17:24
Slym1349 Дата: Вторник, 13.10.2020, 14:30 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, извините не увидел Ваше сообщение и как итог не проверял, потому что решил сам.

Для других пользователей кто столкнется с подобной проблемой выкладываю сюда РЕШЕНИЕ, дабы сэкономить Ваше время.

В общем задачу удалось решить через функцию Create Object, выкладываю код

В Excel

[vba]
Код
Sub Run_power_point()

'даем ссылку на даты внесенные в конкретную ячейку (даты использую формата YYYYMMDD)
Windows("book.xlsm").Activate
Sheets("sheet1").Select
old_date = Range("AE43").Value
new_date = Range("AE39").Value

Set objPP = CreateObject("PowerPoint.Application")

objPP.Visible = True

Path = "  "

Set objPPFile = objPP.Presentations.Open("N:\folder\Box\08_folder\" & new_date & "\" & old_date & "_presentation_daily.pptm")         

Application.EnableEvents = False

'запускаю в открытой презе макрос "Dates_Copies_PDF" прописанный в модуле под названием "Daily"
objPP.Run old_date & "_presentation_daily.pptm!Daily.Dates_Copies_PDF"                    

Application.EnableEvents = True

Set objPPFile = Nothing

Set objPP = Nothing

End Sub
[/vba]

Макрос прописанный в Power Point

[vba]
Код
Sub Dates_Copies_PDF()

Dim excelApplication As Object
Set excelApplication = GetObject(, "Excel.Application")
excelApplication.Visible = True

Dim a As String
Dim b As String

'получаем наши даты из Excel
a = excelApplication.ActiveWorkbook.Sheets("sheet1").Range("AF39").Value  ' DD.MM.YYYY
b = excelApplication.ActiveWorkbook.Sheets("sheet1").Range("AE39").Value   ' YYYYMMDD

Set excelApplication = Nothing

'Используем полученные переменные для работы в Power Point

'Обновление дат на первом слайде
(для того чтобы узнать номер формы:
Кликаем на форму - формат - область выделения(область навигации) - справа будет список всех форм, нумерация ведется СНИЗУ)

ActivePresentation.Slides(1).Shapes(3).TextFrame.TextRange.Lines(4).Text = "Отчёт на " & a
ActivePresentation.Slides(1).Shapes(4).TextFrame.TextRange.Lines(5).Text = "Дата подготовки отчёта: " & b

'Добавляем два слайда из другой презы

    On Error GoTo 0
    On Error Resume Next
    Presentations.Open fileName:="N:\box\" & a & "_" & b & "\" & a & "_ нарушения.pptx", ReadOnly:=msoFalse

'прописываем открыть папку если другая преза не найдена

    If Err.Number <> 0 Then
        MsgBox ("Преза не найдена – открою папку в которой она должна лежать")
        Call Shell("explorer.exe" & " " & "N:\box\" & a & "_" & b & "\", vbNormalFocus)
        Err.Clear

    Else
        ActivePresentation.Slides.Range(Array(1, 2)).Copy 
‘если нужно забрать только 1 слайд то заменить эту строку на ActivePresentation.Slides(1).Copy
        

With Application.Presentations(a & "_нарушения.pptx")
         .Saved = True
         .Close
        End With

        ActiveWindow.View.Paste

'       передвигаем первый слайд на нужное место
        ActivePresentation.Slides(2).MoveTo toPos:=8

'       передвигаем второй слайд на нужное место (т.к. первый уже "уехал" то второй попадает на второе место)
        ActivePresentation.Slides(2).MoveTo toPos:=9

     End If

' Сохраняем обновленную презентацию под новым именем

ActivePresentation.SaveAs ActivePresentation.Path & "\" & b & "_presentation_daily" & ".pptm"

End Sub
[/vba]

Как то так :p


Сообщение отредактировал Slym1349 - Вторник, 13.10.2020, 14:32
 
Ответить
СообщениеPelena, извините не увидел Ваше сообщение и как итог не проверял, потому что решил сам.

Для других пользователей кто столкнется с подобной проблемой выкладываю сюда РЕШЕНИЕ, дабы сэкономить Ваше время.

В общем задачу удалось решить через функцию Create Object, выкладываю код

В Excel

[vba]
Код
Sub Run_power_point()

'даем ссылку на даты внесенные в конкретную ячейку (даты использую формата YYYYMMDD)
Windows("book.xlsm").Activate
Sheets("sheet1").Select
old_date = Range("AE43").Value
new_date = Range("AE39").Value

Set objPP = CreateObject("PowerPoint.Application")

objPP.Visible = True

Path = "  "

Set objPPFile = objPP.Presentations.Open("N:\folder\Box\08_folder\" & new_date & "\" & old_date & "_presentation_daily.pptm")         

Application.EnableEvents = False

'запускаю в открытой презе макрос "Dates_Copies_PDF" прописанный в модуле под названием "Daily"
objPP.Run old_date & "_presentation_daily.pptm!Daily.Dates_Copies_PDF"                    

Application.EnableEvents = True

Set objPPFile = Nothing

Set objPP = Nothing

End Sub
[/vba]

Макрос прописанный в Power Point

[vba]
Код
Sub Dates_Copies_PDF()

Dim excelApplication As Object
Set excelApplication = GetObject(, "Excel.Application")
excelApplication.Visible = True

Dim a As String
Dim b As String

'получаем наши даты из Excel
a = excelApplication.ActiveWorkbook.Sheets("sheet1").Range("AF39").Value  ' DD.MM.YYYY
b = excelApplication.ActiveWorkbook.Sheets("sheet1").Range("AE39").Value   ' YYYYMMDD

Set excelApplication = Nothing

'Используем полученные переменные для работы в Power Point

'Обновление дат на первом слайде
(для того чтобы узнать номер формы:
Кликаем на форму - формат - область выделения(область навигации) - справа будет список всех форм, нумерация ведется СНИЗУ)

ActivePresentation.Slides(1).Shapes(3).TextFrame.TextRange.Lines(4).Text = "Отчёт на " & a
ActivePresentation.Slides(1).Shapes(4).TextFrame.TextRange.Lines(5).Text = "Дата подготовки отчёта: " & b

'Добавляем два слайда из другой презы

    On Error GoTo 0
    On Error Resume Next
    Presentations.Open fileName:="N:\box\" & a & "_" & b & "\" & a & "_ нарушения.pptx", ReadOnly:=msoFalse

'прописываем открыть папку если другая преза не найдена

    If Err.Number <> 0 Then
        MsgBox ("Преза не найдена – открою папку в которой она должна лежать")
        Call Shell("explorer.exe" & " " & "N:\box\" & a & "_" & b & "\", vbNormalFocus)
        Err.Clear

    Else
        ActivePresentation.Slides.Range(Array(1, 2)).Copy 
‘если нужно забрать только 1 слайд то заменить эту строку на ActivePresentation.Slides(1).Copy
        

With Application.Presentations(a & "_нарушения.pptx")
         .Saved = True
         .Close
        End With

        ActiveWindow.View.Paste

'       передвигаем первый слайд на нужное место
        ActivePresentation.Slides(2).MoveTo toPos:=8

'       передвигаем второй слайд на нужное место (т.к. первый уже "уехал" то второй попадает на второе место)
        ActivePresentation.Slides(2).MoveTo toPos:=9

     End If

' Сохраняем обновленную презентацию под новым именем

ActivePresentation.SaveAs ActivePresentation.Path & "\" & b & "_presentation_daily" & ".pptm"

End Sub
[/vba]

Как то так :p

Автор - Slym1349
Дата добавления - 13.10.2020 в 14:30
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!