Function Base64FromFile$(FilePath$) 'получение base64 файла
    Dim ByteArr() As Byte
    Open FilePath For Binary Access Read As #1
    ReDim ByteArr(LOF(1))
    Get #1, 1, ByteArr
    Close #1
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = ByteArr
        Base64FromFile = .text
    End With
End Function


Function EncodeBase64(text As String) As String
  Dim arrData() As Byte
  arrData = StrConv(text, vbFromUnicode)

  Dim objXML As MSXML2.DOMDocument
  Dim objNode As MSXML2.IXMLDOMElement

  Set objXML = New MSXML2.DOMDocument
  Set objNode = objXML.createElement("b64")

  objNode.DataType = "bin.base64"
  objNode.nodeTypedValue = arrData
  EncodeBase64 = objNode.text

  Set objNode = Nothing
  Set objXML = Nothing
End Function

 =ГИПЕРССЫЛКА(Лист2!$B$2;"вперед>>>")

    With objWord.Selection
        
            .Font.Bold = wdToggle
            .TypeParagraph
            .TypeParagraph
            .TypeParagraph
            .TypeParagraph
            .TypeParagraph
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Tables.Add Range:=Selection.Range, numrows:=1, NumColumns:= _
        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
'            .TypeText Text:=" " & aa & "            " & x
        
         End With

 ActiveDocument.Tables.Add Range:=Selection.Range, numrows:=1, NumColumns:= _
        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed

Public Sub Report()
Dim objWord As Word.Application
Dim objDoc As Document
Set objWord = New Word.Application
 
 
objWord.WindowState = wdWindowStateMaximize
 
objWord.Visible = True
objWord.Documents.Add
Set objDoc = objWord.ActiveDocument
Dim rgn As Range
Dim i As Long, j As Long, iRow As Long, iColumn As Long
Set rgn = Worksheets(1).Range("a1").CurrentRegion
iRow = rgn.Rows.Count
iColumn = rgn.Columns.Count
 
 
        With objDoc
        .Tables.Add Range:=objWord.Selection.Range, NumRows:=iRow, NumColumns:=iColumn
        .Tables(1).Columns.AutoFit
         
        End With
For i = 1 To iRow
For j = 1 To iColumn
 
        With objWord.Selection
        .TypeText Text:=Worksheets(1).Cells(i, j).Value
        .MoveRight Unit:=wdCell
        End With
Next j
Next i
objWord.Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow
End Sub

Public Sub Report()
Dim objWord As Word.Application
Dim objDoc As Document
Set objWord = New Word.Application


objWord.WindowState = wdWindowStateMaximize

objWord.Visible = True
objWord.Documents.Add
Set objDoc = objWord.ActiveDocument
Dim rgn As Range
Dim i As Long, j As Long, iRow As Long, iColumn As Long
Set rgn = Worksheets(1).Range("a1").CurrentRegion
iRow = rgn.Rows.Count
iColumn = rgn.Columns.Count


        With objDoc
        .Tables.Add Range:=objWord.Selection.Range, NumRows:=iRow, NumColumns:=iColumn
        .Tables(1).Columns.AutoFit
        
        End With
For i = 1 To iRow
For j = 1 To iColumn

        With objWord.Selection
        .TypeText Text:=Worksheets(1).Cells(i, j).Value
        .MoveRight Unit:=wdCell
        End With
Next j
Next i
objWord.Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow
End Sub

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        sNextFiles = Dir
.
        действия с файлом
          
        ActiveWorkbook.Sheets(1).Range("A1").Value = "пурурум"
          
          
        ActiveWorkbook.Close True
        sFiles = sNextFiles
    Loop
    Application.ScreenUpdating = True
End Sub

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
        
        ActiveWorkbook.Sheets(1).Range("A1").Value = "ТРАТАТА"
        
        
        ActiveWorkbook.Close True
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
End Sub