' === Объявление 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