Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » evgeniygeo
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 101 След.
Р7 офис, Импортозамещение аналог excel
 
#
28.04.2026 07:19:02
haza,
расскажите подробнее пожалуйста. все ли из MS VBA запускается? аналоги PQ\PP? Ценник на лицензии и поддержку такой же как у Р7?
 
Перейти    
Обновления и изменения, Облачный сервис Power BI бесконечно обновляют. Когда это закончится..
 
#
28.04.2026 07:13:42
Vladimir Ch,
я сторонник решений, которые не пугают на входе пользователей, т.к. зачастую разработчиков внутри нет, а работать нужно)
 
Перейти    
Обновления и изменения, Облачный сервис Power BI бесконечно обновляют. Когда это закончится..
 
#
21.04.2026 06:39:55
Vladimir Ch,
тоже просил рассмотреть этот вариант, но MS в целом теперь не целевое решение(((

+у руководства есть понимание, что Power BI это не полноценный BI, а просто Excel завернутый в BI (предполагаю, что из-за его не трудного освоения на старте). И его нельзя сравнивать с Qlik Sense, Tableau и прочими.
Изменено: evgeniygeo - 21.04.2026 06:42:39
 
Перейти    
Обновления и изменения, Облачный сервис Power BI бесконечно обновляют. Когда это закончится..
 
#
20.04.2026 08:03:02
Михаил Л,
спасибо за предложение!
Пока смотрю в стороны скрипта на power shell  :)
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
14.04.2026 05:26:26
Лалыч,
жаль, что на корпоративные ПК ничего из этого поставить не могу
 
Перейти    
Обновления и изменения, Облачный сервис Power BI бесконечно обновляют. Когда это закончится..
 
#
13.04.2026 12:47:18
Михаил Л,
Приветствую!
Вам везет, что еще Power BI облачный есть. У нас теперь только десктоп и ручные обновления  :cry:
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
31.03.2026 21:00:28
Для себя выявил новую проблему. У меня в PDF частенько попадаются огромные картинки по дрине и ширине, и данный код их некорректно обрабатывает. Пока впечатление, что через Word не получится(
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
31.03.2026 19:18:29
Оказалось, что это параметр в реестр "DisableConvertPdfWarning", на который надо поставить "1"

Без Power Shell (ИБ не одобряют) получилось вот так:
Код
' === Объявление API функций для работы с реестром ===
#If VBA7 Then
    Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, _
        ByVal samDesired As Long, phkResult As LongPtr) As Long
        
    Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
        ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, _
        ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
        
    Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As LongPtr) As Long
        
    Private Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" ( _
        ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal Reserved As Long, _
        ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
        lpSecurityAttributes As Any, phkResult As LongPtr, lpdwDisposition As Long) As Long
#Else
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
        ByVal samDesired As Long, phkResult As Long) As Long
        
    Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
        ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
        ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
        
    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As Long) As Long
        
    Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" ( _
        ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
        ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
        lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
#End If

' === Константы для реестра ===
Private Const HKEY_CURRENT_USER As LongPtr = &H80000001
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_WRITE As Long = &H20006
Private Const REG_DWORD As Long = 4

' === Функция для отключения предупреждения PDF ===
Private Sub DisablePDFConversionWarning()
    Dim hKey As LongPtr
    Dim lResult As Long
    Dim sSubKey As String
    Dim dwValue As Long
    
    dwValue = 1  ' 1 = отключить предупреждение
    
    ' Путь к ключу реестра для Word 2016/2019/2021/365
    sSubKey = "Software\Microsoft\Office\16.0\Word\Options"
    
    ' Создаем или открываем ключ
    lResult = RegCreateKeyEx(HKEY_CURRENT_USER, sSubKey, 0, vbNullString, 0, KEY_WRITE, ByVal 0, hKey, 0)
    
    If lResult = 0 Then
        ' Устанавливаем значение DisableConvertPdfWarning
        lResult = RegSetValueEx(hKey, "DisableConvertPdfWarning", 0, REG_DWORD, dwValue, 4)
        RegCloseKey hKey
    End If
End Sub

Sub ConvertRangeToPDF_WordEngin()
    
    Dim rng As Range
    Dim cell As Range
    Dim filesList As New Collection
    Dim i As Long
    Dim outputPath As String
    Dim wdApp As Object, wdDoc As Object, wdSel As Object
    Dim wasOpen As Boolean
    Dim fPath As String
    Dim fileExt As String
    
    ' ---- 1. Чтение путей из диапазона E7:E18 ----
    On Error Resume Next
    Set rng = ThisWorkbook.ActiveSheet.Range("E7:E18")
    On Error GoTo 0
    
    If rng Is Nothing Then
        MsgBox "Не удалось получить диапазон E7:E18", vbExclamation
        Exit Sub
    End If
    
    For Each cell In rng
        fPath = Trim(cell.Value)
        If fPath <> "" Then
            If Dir(fPath) <> "" Then
                filesList.Add fPath
            Else
                Debug.Print "Файл не найден: " & fPath
            End If
        End If
    Next cell
    
    If filesList.Count = 0 Then
        MsgBox "Нет доступных файлов в диапазоне E7:E18!", vbExclamation
        Exit Sub
    End If
    
    ' ---- 2. Настройки (только для изображений) ----
    Dim pageSize As String
    pageSize = InputBox("Выберите размер страницы для ИЗОБРАЖЕНИЙ:" & vbCrLf & vbCrLf & _
                        "1 - A4 (210 x 297 мм)" & vbCrLf & _
                        "2 - A3 (297 x 420 мм)" & vbCrLf & _
                        "3 - Letter (216 x 279 мм)" & vbCrLf & _
                        "4 - Подогнать под размер картинки" & vbCrLf & _
                        "5 - Квадрат (210 x 210 мм)", _
                        "Настройки PDF", "1")
    
    If pageSize = "" Then Exit Sub
    
    Dim orientation As String
    orientation = InputBox("Ориентация страницы для ИЗОБРАЖЕНИЙ:" & vbCrLf & vbCrLf & _
                           "1 - Книжная (портрет)" & vbCrLf & _
                           "2 - Альбомная (ландшафт)" & vbCrLf & _
                           "3 - Авто (по ориентации картинки)", _
                           "Ориентация", "3")
    
    If orientation = "" Then Exit Sub
    
    ' ---- 3. Путь сохранения ----
    outputPath = Application.GetSaveAsFilename( _
        InitialFileName:="Output.pdf", _
        FileFilter:="PDF (*.pdf), *.pdf", _
        Title:="Сохранить PDF")
    
    If outputPath = "False" Then Exit Sub
    If LCase(Right(outputPath, 4)) <> ".pdf" Then outputPath = outputPath & ".pdf"
    
    Call DisablePDFConversionWarning
    
    ' ---- 4. Инициализация Word ----
    Application.StatusBar = "Запуск Word..."
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    wasOpen = Not (wdApp Is Nothing)
    On Error GoTo 0
    
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    
    wdApp.Visible = True
    wdApp.DisplayAlerts = False
    wdApp.Options.ConfirmConversions = False
    
    Set wdDoc = wdApp.Documents.Add
    Set wdSel = wdApp.Selection
    
    ' Константы Word
    Const wdSectionBreakNextPage As Long = 3
    Const wdOrientPortrait As Long = 1
    Const wdOrientLandscape As Long = 0
    Const wdSaveFormatPDF As Long = 17
    Const wdCollapseEnd As Long = 0
    
    Dim isFirstItem As Boolean
    isFirstItem = True
    
    ' ---- 5. Обработка файлов ----
    For i = 1 To filesList.Count
        
        Application.StatusBar = "Обработка " & i & "/" & filesList.Count & "..."
        DoEvents
        
        fPath = filesList(i)
        fileExt = LCase(Right(fPath, Len(fPath) - InStrRev(fPath, ".")))
        
        ' Добавляем разрыв раздела (кроме первого элемента)
        If Not isFirstItem Then
            wdSel.InsertBreak wdSectionBreakNextPage
            wdSel.Collapse wdCollapseEnd
        End If
        isFirstItem = False
        
        ' ---- Обработка PDF ----
        If fileExt = "pdf" Then
            On Error Resume Next
            ' Используем InsertFile - вставляет содержимое напрямую
            wdSel.InsertFile Filename:=fPath, ConfirmConversions:=False
            
            If Err.Number <> 0 Then
                Debug.Print "Не удалось вставить PDF: " & fPath
                Err.Clear
            End If
            On Error GoTo 0
            
            ' Переходим в конец вставленного содержимого
            wdSel.Collapse wdCollapseEnd
        
        ' ---- Обработка Изображений ----
        ElseIf fileExt = "jpg" Or fileExt = "jpeg" Or fileExt = "png" Or _
               fileExt = "bmp" Or fileExt = "gif" Or fileExt = "tif" Or fileExt = "tiff" Then
            
            Dim inlinePic As Object
            Set inlinePic = wdSel.InlineShapes.AddPicture(Filename:=fPath, LinkToFile:=False, SaveWithDocument:=True)
            
            Dim imgW As Single, imgH As Single
            imgW = inlinePic.Width
            imgH = inlinePic.Height
            
            With wdSel.PageSetup
                .TopMargin = 0
                .BottomMargin = 0
                .LeftMargin = 0
                .RightMargin = 0
                
                ' 1. Установка размера страницы
                Select Case pageSize
                    Case "1": .PageWidth = 595.28: .PageHeight = 841.89   ' A4
                    Case "2": .PageWidth = 841.89: .PageHeight = 1190.55  ' A3
                    Case "3": .PageWidth = 612: .PageHeight = 792          ' Letter
                    Case "5": .PageWidth = 595.28: .PageHeight = 595.28    ' Квадрат
                    Case "4"
                        If imgW > 1587 Or imgH > 1587 Then
                            Dim ratio As Single
                            ratio = 1587 / IIf(imgW > imgH, imgW, imgH)
                            .PageWidth = imgW * ratio
                            .PageHeight = imgH * ratio
                            inlinePic.Width = .PageWidth
                            inlinePic.Height = .PageHeight
                        Else
                            .PageWidth = imgW
                            .PageHeight = imgH
                        End If
                    Case Else: .PageWidth = 595.28: .PageHeight = 841.89
                End Select
                
                ' 2. Установка ориентации
                If pageSize = "4" Then
                    If .PageWidth > .PageHeight Then .orientation = wdOrientLandscape
                    If .PageHeight > .PageWidth Then .orientation = wdOrientPortrait
                Else
                    If orientation = "3" Then ' Авто
                        If imgW > imgH Then
                            .orientation = wdOrientLandscape
                        Else
                            .orientation = wdOrientPortrait
                        End If
                    ElseIf orientation = "2" Then ' Альбомная
                        .orientation = wdOrientLandscape
                    Else ' Книжная
                        .orientation = wdOrientPortrait
                    End If
                End If
            End With
            
            ' 3. Масштабирование картинки
            If pageSize <> "4" Then
                Dim availW As Single, availH As Single
                availW = wdSel.PageSetup.PageWidth - wdSel.PageSetup.LeftMargin - wdSel.PageSetup.RightMargin
                availH = wdSel.PageSetup.PageHeight - wdSel.PageSetup.TopMargin - wdSel.PageSetup.BottomMargin
                
                Dim scX As Single, scY As Single, sc As Single
                inlinePic.LockAspectRatio = False
                scX = availW / imgW
                scY = availH / imgH
                sc = IIf(scX < scY, scX, scY)
                
                inlinePic.LockAspectRatio = True
                inlinePic.Width = imgW * sc
                inlinePic.Height = imgH * sc
                
                wdSel.ParagraphFormat.Alignment = 1 ' Центр
            Else
                wdSel.ParagraphFormat.Alignment = 1
            End If
            
            wdSel.ParagraphFormat.SpaceBefore = 0
            wdSel.ParagraphFormat.SpaceAfter = 0
        End If
        
    Next i
    
    ' ---- 6. Экспорт в PDF ----
    Application.StatusBar = "Сохранение PDF..."
    wdDoc.SaveAs2 Filename:=outputPath, FileFormat:=wdSaveFormatPDF
    
    wdDoc.Close SaveChanges:=False
    If Not wasOpen Then wdApp.Quit
    
    Application.StatusBar = False
    MsgBox "PDF успешно создан!" & vbCrLf & _
           "Файл: " & outputPath & vbCrLf & _
           "Обработано файлов: " & filesList.Count, vbInformation

End Sub
Изменено: evgeniygeo - 31.03.2026 19:31:29
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
31.03.2026 18:09:12
Wild.Godlike,
все понял, не помогло. Все равно выходит диалоговое окно


Код
Sub ConvertRangeToPDF_WordEngin()
    
    Dim rng As Range
    Dim cell As Range
    Dim filesList As New Collection
    Dim i As Long
    Dim outputPath As String
    Dim wdApp As Object, wdDoc As Object, wdSel As Object
    Dim wasOpen As Boolean
    Dim fPath As String
    Dim fileExt As String
    
    ' ---- 1. Чтение путей из диапазона E7:E18 ----
    On Error Resume Next
    Set rng = ThisWorkbook.ActiveSheet.Range("E7:E18")
    On Error GoTo 0
    
    If rng Is Nothing Then
        MsgBox "Не удалось получить диапазон E7:E18", vbExclamation
        Exit Sub
    End If
    
    For Each cell In rng
        fPath = Trim(cell.Value)
        If fPath <> "" Then
            If Dir(fPath) <> "" Then
                filesList.Add fPath
            Else
                Debug.Print "Файл не найден: " & fPath
            End If
        End If
    Next cell
    
    If filesList.Count = 0 Then
        MsgBox "Нет доступных файлов в диапазоне E7:E18!", vbExclamation
        Exit Sub
    End If
    
    ' ---- 2. Настройки (только для изображений) ----
    Dim pageSize As String
    pageSize = InputBox("Выберите размер страницы для ИЗОБРАЖЕНИЙ:" & vbCrLf & vbCrLf & _
                        "1 - A4 (210 x 297 мм)" & vbCrLf & _
                        "2 - A3 (297 x 420 мм)" & vbCrLf & _
                        "3 - Letter (216 x 279 мм)" & vbCrLf & _
                        "4 - Подогнать под размер картинки" & vbCrLf & _
                        "5 - Квадрат (210 x 210 мм)", _
                        "Настройки PDF", "1")
    
    If pageSize = "" Then Exit Sub
    
    Dim orientation As String
    orientation = InputBox("Ориентация страницы для ИЗОБРАЖЕНИЙ:" & vbCrLf & vbCrLf & _
                           "1 - Книжная (портрет)" & vbCrLf & _
                           "2 - Альбомная (ландшафт)" & vbCrLf & _
                           "3 - Авто (по ориентации картинки)", _
                           "Ориентация", "3")
    
    If orientation = "" Then Exit Sub
    
    ' ---- 3. Путь сохранения ----
    outputPath = Application.GetSaveAsFilename( _
        InitialFileName:="Output.pdf", _
        FileFilter:="PDF (*.pdf), *.pdf", _
        Title:="Сохранить PDF")
    
    If outputPath = "False" Then Exit Sub
    If LCase(Right(outputPath, 4)) <> ".pdf" Then outputPath = outputPath & ".pdf"
    
    ' ---- 4. Инициализация Word ----
    Application.StatusBar = "Запуск Word..."
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    wasOpen = Not (wdApp Is Nothing)
    On Error GoTo 0
    
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    
    wdApp.Visible = False
    wdApp.DisplayAlerts = False
    wdApp.Options.ConfirmConversions = False
    
    Set wdDoc = wdApp.Documents.Add
    Set wdSel = wdApp.Selection
    
    ' Константы Word
    Const wdSectionBreakNextPage As Long = 3
    Const wdOrientPortrait As Long = 1
    Const wdOrientLandscape As Long = 0
    Const wdSaveFormatPDF As Long = 17
    Const wdCollapseEnd As Long = 0
    
    Dim isFirstItem As Boolean
    isFirstItem = True
    
    ' ---- 5. Обработка файлов ----
    For i = 1 To filesList.Count
        
        Application.StatusBar = "Обработка " & i & "/" & filesList.Count & "..."
        DoEvents
        
        fPath = filesList(i)
        fileExt = LCase(Right(fPath, Len(fPath) - InStrRev(fPath, ".")))
        
        ' Добавляем разрыв раздела (кроме первого элемента)
        If Not isFirstItem Then
            wdSel.InsertBreak wdSectionBreakNextPage
            wdSel.Collapse wdCollapseEnd
        End If
        isFirstItem = False
        
        ' ---- Обработка PDF ----
        If fileExt = "pdf" Then
            On Error Resume Next
            ' Используем InsertFile - вставляет содержимое напрямую
            wdSel.InsertFile Filename:=fPath, ConfirmConversions:=False
            
            If Err.Number <> 0 Then
                Debug.Print "Не удалось вставить PDF: " & fPath
                Err.Clear
            End If
            On Error GoTo 0
            
            ' Переходим в конец вставленного содержимого
            wdSel.Collapse wdCollapseEnd
        
        ' ---- Обработка Изображений ----
        ElseIf fileExt = "jpg" Or fileExt = "jpeg" Or fileExt = "png" Or _
               fileExt = "bmp" Or fileExt = "gif" Or fileExt = "tif" Or fileExt = "tiff" Then
            
            Dim inlinePic As Object
            Set inlinePic = wdSel.InlineShapes.AddPicture(Filename:=fPath, LinkToFile:=False, SaveWithDocument:=True)
            
            Dim imgW As Single, imgH As Single
            imgW = inlinePic.Width
            imgH = inlinePic.Height
            
            With wdSel.PageSetup
                .TopMargin = 0
                .BottomMargin = 0
                .LeftMargin = 0
                .RightMargin = 0
                
                ' 1. Установка размера страницы
                Select Case pageSize
                    Case "1": .PageWidth = 595.28: .PageHeight = 841.89   ' A4
                    Case "2": .PageWidth = 841.89: .PageHeight = 1190.55  ' A3
                    Case "3": .PageWidth = 612: .PageHeight = 792          ' Letter
                    Case "5": .PageWidth = 595.28: .PageHeight = 595.28    ' Квадрат
                    Case "4"
                        If imgW > 1587 Or imgH > 1587 Then
                            Dim ratio As Single
                            ratio = 1587 / IIf(imgW > imgH, imgW, imgH)
                            .PageWidth = imgW * ratio
                            .PageHeight = imgH * ratio
                            inlinePic.Width = .PageWidth
                            inlinePic.Height = .PageHeight
                        Else
                            .PageWidth = imgW
                            .PageHeight = imgH
                        End If
                    Case Else: .PageWidth = 595.28: .PageHeight = 841.89
                End Select
                
                ' 2. Установка ориентации
                If pageSize = "4" Then
                    If .PageWidth > .PageHeight Then .orientation = wdOrientLandscape
                    If .PageHeight > .PageWidth Then .orientation = wdOrientPortrait
                Else
                    If orientation = "3" Then ' Авто
                        If imgW > imgH Then
                            .orientation = wdOrientLandscape
                        Else
                            .orientation = wdOrientPortrait
                        End If
                    ElseIf orientation = "2" Then ' Альбомная
                        .orientation = wdOrientLandscape
                    Else ' Книжная
                        .orientation = wdOrientPortrait
                    End If
                End If
            End With
            
            ' 3. Масштабирование картинки
            If pageSize <> "4" Then
                Dim availW As Single, availH As Single
                availW = wdSel.PageSetup.PageWidth - wdSel.PageSetup.LeftMargin - wdSel.PageSetup.RightMargin
                availH = wdSel.PageSetup.PageHeight - wdSel.PageSetup.TopMargin - wdSel.PageSetup.BottomMargin
                
                Dim scX As Single, scY As Single, sc As Single
                inlinePic.LockAspectRatio = False
                scX = availW / imgW
                scY = availH / imgH
                sc = IIf(scX < scY, scX, scY)
                
                inlinePic.LockAspectRatio = True
                inlinePic.Width = imgW * sc
                inlinePic.Height = imgH * sc
                
                wdSel.ParagraphFormat.Alignment = 1 ' Центр
            Else
                wdSel.ParagraphFormat.Alignment = 1
            End If
            
            wdSel.ParagraphFormat.SpaceBefore = 0
            wdSel.ParagraphFormat.SpaceAfter = 0
        End If
        
    Next i
    
    ' ---- 6. Экспорт в PDF ----
    Application.StatusBar = "Сохранение PDF..."
    wdDoc.SaveAs2 Filename:=outputPath, FileFormat:=wdSaveFormatPDF
    
    wdDoc.Close SaveChanges:=False
    If Not wasOpen Then wdApp.Quit
    
    Application.StatusBar = False
    MsgBox "PDF успешно создан!" & vbCrLf & _
           "Файл: " & outputPath & vbCrLf & _
           "Обработано файлов: " & filesList.Count, vbInformation

End Sub


Есть стабильное ощущение, что именно эта модалка это другой параметр какой-то)))
Изменено: evgeniygeo - 31.03.2026 19:01:05
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
31.03.2026 18:03:35
Wild.Godlike,
Спасибо, попробую.
А этот параметр можно изменять через VBA?
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
31.03.2026 15:53:19
irabel,
тоже не помогает, кто-то на форуме советовал в реестре подменять значение, но тоже не помогло
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
30.03.2026 14:39:06
irabel,
проблема в том, что я не могу на все пк поставить галочку(
ищу решение в коде
 
Перейти    
Word - открыть PDF проигнорировав диалоговое окно
 
#
30.03.2026 12:59:02
Коллеги, привет!
Есть ли идеи как проигнорировать диалоговое окно при открытии PDF?


Пробовал так, но не помогло:
Код
ConfirmConversions = False
Visible = True


Код
Sub ConvertRangeToPDF_WordEngin2()
    
    Dim rng As Range
    Dim cell As Range
    Dim filesList As New Collection
    Dim i As Long
    Dim outputPath As String
    Dim wdApp As Object, wdDoc As Object, wdSel As Object
    Dim wasOpen As Boolean
    Dim fPath As String
    Dim fileExt As String
    
    ' ---- 1. Чтение путей из диапазона E7:E18 ----
    On Error Resume Next
    Set rng = ThisWorkbook.ActiveSheet.Range("E7:E18")
    On Error GoTo 0
    
    If rng Is Nothing Then
        MsgBox "Не удалось получить диапазон E7:E18", vbExclamation
        Exit Sub
    End If
    
    For Each cell In rng
        fPath = Trim(cell.Value)
        If fPath <> "" Then
            If Dir(fPath) <> "" Then
                filesList.Add fPath
            Else
                Debug.Print "Файл не найден: " & fPath
            End If
        End If
    Next cell
    
    If filesList.Count = 0 Then
        MsgBox "Нет доступных файлов в диапазоне E7:E18!", vbExclamation
        Exit Sub
    End If
    
    ' ---- 2. Настройки (только для изображений) ----
    Dim pageSize As String
    pageSize = InputBox("Выберите размер страницы для ИЗОБРАЖЕНИЙ:" & vbCrLf & vbCrLf & _
                        "1 - A4 (210 x 297 мм)" & vbCrLf & _
                        "2 - A3 (297 x 420 мм)" & vbCrLf & _
                        "3 - Letter (216 x 279 мм)" & vbCrLf & _
                        "4 - Подогнать под размер картинки" & vbCrLf & _
                        "5 - Квадрат (210 x 210 мм)", _
                        "Настройки PDF", "1")
    
    If pageSize = "" Then Exit Sub
    
    Dim orientation As String
    orientation = InputBox("Ориентация страницы для ИЗОБРАЖЕНИЙ:" & vbCrLf & vbCrLf & _
                           "1 - Книжная (портрет)" & vbCrLf & _
                           "2 - Альбомная (ландшафт)" & vbCrLf & _
                           "3 - Авто (по ориентации картинки)", _
                           "Ориентация", "3")
    
    If orientation = "" Then Exit Sub
    
    ' ---- 3. Путь сохранения ----
    outputPath = Application.GetSaveAsFilename( _
        InitialFileName:="Output.pdf", _
        FileFilter:="PDF (*.pdf), *.pdf", _
        Title:="Сохранить PDF")
    
    If outputPath = "False" Then Exit Sub
    If LCase(Right(outputPath, 4)) <> ".pdf" Then outputPath = outputPath & ".pdf"
    
    ' ---- 4. Инициализация Word ----
    Application.StatusBar = "Запуск Word..."
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    wasOpen = Not (wdApp Is Nothing)
    On Error GoTo 0
    
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    
    wdApp.Visible = True
    wdApp.DisplayAlerts = False
    
    Set wdDoc = wdApp.Documents.Add
    Set wdSel = wdApp.Selection
    
    ' Константы Word
    Const wdSectionBreakNextPage As Long = 3
    Const wdOrientPortrait As Long = 1
    Const wdOrientLandscape As Long = 0
    Const wdSaveFormatPDF As Long = 17
    Const wdCollapseEnd As Long = 0
    
    Dim isFirstItem As Boolean
    isFirstItem = True
    
    ' ---- 5. Обработка файлов ----
    For i = 1 To filesList.Count
        
        Application.StatusBar = "Обработка " & i & "/" & filesList.Count & "..."
        DoEvents
        
        fPath = filesList(i)
        fileExt = LCase(Right(fPath, Len(fPath) - InStrRev(fPath, ".")))
        
        ' Добавляем разрыв раздела (кроме первого элемента)
        If Not isFirstItem Then
            wdSel.InsertBreak wdSectionBreakNextPage
            wdSel.Collapse wdCollapseEnd
        End If
        isFirstItem = False
        
        ' ---- Обработка PDF ----
        If fileExt = "pdf" Then
            On Error Resume Next
            ' Используем InsertFile - вставляет содержимое напрямую
            wdSel.InsertFile Filename:=fPath
            
            If Err.Number <> 0 Then
                Debug.Print "Не удалось вставить PDF: " & fPath
                Err.Clear
            End If
            On Error GoTo 0
            
            ' Переходим в конец вставленного содержимого
            wdSel.Collapse wdCollapseEnd
        
        ' ---- Обработка Изображений ----
        ElseIf fileExt = "jpg" Or fileExt = "jpeg" Or fileExt = "png" Or _
               fileExt = "bmp" Or fileExt = "gif" Or fileExt = "tif" Or fileExt = "tiff" Then
            
            Dim inlinePic As Object
            Set inlinePic = wdSel.InlineShapes.AddPicture(Filename:=fPath, LinkToFile:=False, SaveWithDocument:=True)
            
            Dim imgW As Single, imgH As Single
            imgW = inlinePic.Width
            imgH = inlinePic.Height
            
            With wdSel.PageSetup
                .TopMargin = 0
                .BottomMargin = 0
                .LeftMargin = 0
                .RightMargin = 0
                
                ' 1. Установка размера страницы
                Select Case pageSize
                    Case "1": .PageWidth = 595.28: .PageHeight = 841.89   ' A4
                    Case "2": .PageWidth = 841.89: .PageHeight = 1190.55  ' A3
                    Case "3": .PageWidth = 612: .PageHeight = 792          ' Letter
                    Case "5": .PageWidth = 595.28: .PageHeight = 595.28    ' Квадрат
                    Case "4"
                        If imgW > 1587 Or imgH > 1587 Then
                            Dim ratio As Single
                            ratio = 1587 / IIf(imgW > imgH, imgW, imgH)
                            .PageWidth = imgW * ratio
                            .PageHeight = imgH * ratio
                            inlinePic.Width = .PageWidth
                            inlinePic.Height = .PageHeight
                        Else
                            .PageWidth = imgW
                            .PageHeight = imgH
                        End If
                    Case Else: .PageWidth = 595.28: .PageHeight = 841.89
                End Select
                
                ' 2. Установка ориентации
                If pageSize = "4" Then
                    If .PageWidth > .PageHeight Then .orientation = wdOrientLandscape
                    If .PageHeight > .PageWidth Then .orientation = wdOrientPortrait
                Else
                    If orientation = "3" Then ' Авто
                        If imgW > imgH Then
                            .orientation = wdOrientLandscape
                        Else
                            .orientation = wdOrientPortrait
                        End If
                    ElseIf orientation = "2" Then ' Альбомная
                        .orientation = wdOrientLandscape
                    Else ' Книжная
                        .orientation = wdOrientPortrait
                    End If
                End If
            End With
            
            ' 3. Масштабирование картинки
            If pageSize <> "4" Then
                Dim availW As Single, availH As Single
                availW = wdSel.PageSetup.PageWidth - wdSel.PageSetup.LeftMargin - wdSel.PageSetup.RightMargin
                availH = wdSel.PageSetup.PageHeight - wdSel.PageSetup.TopMargin - wdSel.PageSetup.BottomMargin
                
                Dim scX As Single, scY As Single, sc As Single
                inlinePic.LockAspectRatio = False
                scX = availW / imgW
                scY = availH / imgH
                sc = IIf(scX < scY, scX, scY)
                
                inlinePic.LockAspectRatio = True
                inlinePic.Width = imgW * sc
                inlinePic.Height = imgH * sc
                
                wdSel.ParagraphFormat.Alignment = 1 ' Центр
            Else
                wdSel.ParagraphFormat.Alignment = 1
            End If
            
            wdSel.ParagraphFormat.SpaceBefore = 0
            wdSel.ParagraphFormat.SpaceAfter = 0
        End If
        
    Next i
    
    ' ---- 6. Экспорт в PDF ----
    Application.StatusBar = "Сохранение PDF..."
    wdDoc.SaveAs2 Filename:=outputPath, FileFormat:=wdSaveFormatPDF
    
    wdDoc.Close SaveChanges:=False
    If Not wasOpen Then wdApp.Quit
    
    Application.StatusBar = False
    MsgBox "PDF успешно создан!" & vbCrLf & _
           "Файл: " & outputPath & vbCrLf & _
           "Обработано файлов: " & filesList.Count, vbInformation

End Sub
Изменено: evgeniygeo - 30.03.2026 13:03:03
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
30.03.2026 05:34:16
Лалыч,
насколько я понимаю, в этом решении для моего случая есть несколько проблем:
1. Формат размера картинок разный, а Power Point делает их одинаковыми по последней картинке
2. Иногда, в конвертации и объединении участвует PDF,


Пока решил с помощью api вышеописанного ПО, но зарубили ИБ. Сейчас смотрю в сторону Word.
 
Перейти    
пример RFA/RFP/ТЗ на разработку Power BI отчетов
 
#
25.02.2026 15:58:40
Коллеги, здравствуйте!
Кто-то может поделиться примером RFA/RFP/ТЗ на разработку Power BI отчетов? Пытаюсь найти, чтобы дать в качестве примера бизнесу
 
Перейти    
Искусственный интеллект (ИИ) на службе Excel, Искусственный интеллект напишет код макроса, формулы, функции и тд.
 
#
17.02.2026 05:59:26
sokol92,
можно попробовать собрать ассистента ИИ чисто под VBA как вариант. Тогда ответы будут гораздо точнее  ;)

Я пробовал подобное на более мелких задачах - получение данных по API. Если спросить просто так, то ответы из 2017 с хз какой документацией + галлюцинациями из вообще левых API. Но если скормить документацию по API, то ответы на 90% удовлетворяют моим требованиям.
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
16.02.2026 12:00:52
Aлeкceй,
большое спасибо за предложение, но боюсь будет аналогичное отношение как и к bat  :D
Изменено: evgeniygeo - 16.02.2026 12:02:06
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
16.02.2026 07:17:29
irabel,
пробовал, получается отвратительное качество и проблемы с качеством сформированного pdf(
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
15.02.2026 12:56:43
irabel,
оно, большое Вам спасибо!
Жаль, что получилось подключиться только через power shell, а наша безопасность против такого подхода...(
Пробовал через WEB API, но даже не успев закончить мне подсветили на конф данных...(

Скрытый текст

Ищу теперь другие варианты
Изменено: evgeniygeo - 15.02.2026 13:00:01
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
10.02.2026 08:52:46
нашел все API, теперь грызу его)))
 
Перейти    
Искусственный интеллект (ИИ) на службе Excel, Искусственный интеллект напишет код макроса, формулы, функции и тд.
 
#
10.02.2026 08:35:39
меня больше всего беспокоит безопасность данных...зачастую пользователь вбивает в ИИ чуть ли не детальные планы по развитию компании и просит найти орфографические ошибки или помочь построить график......

из бесплатного, легкодоступного и запускаемого локально я бы предпочел deppseek и qwen за счет своих мультивозможностей
Изменено: evgeniygeo - 10.02.2026 08:36:41
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
09.02.2026 16:52:51
bigorq,
к сожалению, только https://www.pdf24.org/ru/ + их же ПО можно установить на ПК народу. Но там тоже не нашел вариантов как выполнить задуманное кроме горячих клавиш
Изменено: evgeniygeo - 09.02.2026 16:53:15
 
Перейти    
WEB API или другие способы подключения к PDF Creator 24
 
#
02.02.2026 18:36:14
Привет!
Появилась задачка в конвертации картинок в PDF и объединение их в один файл. Все это необходимо запускать из Excel.

Из разрешённого ПО есть https://www.pdf24.org/ru/. Но читая не могу найти информацию по API. Может кто-то заморачивался подобным?

Сейчас не объединяя подряд печатаю файлы (PDF, JPG, PNG) с помощью горячих клавиш и VBA.
 
Перейти    
Выпадающие списки
 
#
12.01.2026 11:55:56
Цитата
farvator написал:
Интересно опыт других почитать, как они на практике пользуются, и есть ли в списках серьезный смысл.
однозначно есть, как для меня базовый смысл - убить проблему с анализом разношерстных данных. Когда пользователи записывают одну и ту же информацию ручками (например, материал), то зачастую они делают это по-разному и в итоге возникает проблема с тем, как привести эти данные к единому стандарту.
Также, часто возникают проблемы, когда списки должны быть взаимосвязаны. И если просто сделать два выпадающих списках без связи между собой, то пользователи зачастую выбирают "нереальные" связки, а если оставить и вовсе без списков, то первая проблема возникнет в 2 раза сильнее.

P.S. если подобный вопрос задать в GPT там наверно пунктов 10 минимум будет  ;)
Изменено: evgeniygeo - 12.01.2026 11:57:14
 
Перейти    
Влияние макросов на мозг человека
 
#
12.01.2026 11:52:34
suricat555, я не очень силен в макросах и прочих функциях эксель, но что-то да могу, поэтому рассматриваю это как кругозор, который помогает в жизни, но чаще конечно в похожих/близких задачах (управление проектами, построение архитектуры, программирование на других языках программирования, нестандартный подход к задачам и прочее)
 
Перейти    
MultiProcessing или хакерский менеджер процессов на VBA, Воскрешение (вторая жизнь) VBA
 
#
10.12.2025 13:59:50
Senaki,
Zeus_0x01,
у Вас ведь и правда хорошо получается, поэтому я очень надеюсь, что Вы не сдадитесь и будете продолжать.
Но текущие методы на данном форуме с Вашей стороны, мне не очень нравятся
Изменено: evgeniygeo - 10.12.2025 14:01:27
 
Перейти    
Power BI. Табличный отчет., формирование сложной таблицы с пустыми строками на основе таблицы из excel
 
#
26.11.2025 06:24:38
Владимир Пешков,
привет!
а можете показать, что примерно хотите на выходе?
 
Перейти    
Посоветуйте какую Книгу хорошую по таблицам в экселе. что-нибудь с озона, Книга
 
#
24.11.2025 12:14:30
lit8,
https://www.planetaexcel.ru/books/
 
Перейти    
Excel - новые альтернативы
 
#
07.10.2025 06:13:41
БМВ,
да, на сайте совсем нет инфы про то, что вы рассказываете.
А их основное ПО, меня к сожалению, совсем не заинтересовало.
Изменено: evgeniygeo - 07.10.2025 06:13:57
 
Перейти    
Excel - новые альтернативы
 
#
01.10.2025 12:28:01
БМВ,
очень интересно, можно все же ссылочку на продукт?)))
 
Перейти    
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 101 След.
Наверх