Excel vba вставить картинку в word

Sub ExportExcelToWord()

‘PURPOSE: Copy/Paste An Excel Table, Text, & Logo Image Into a New Word Document
‘NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
‘SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim myText As Excel.Range
Dim myLogo As Excel.Shape

‘Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

‘Copy Data from Excel
  Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects(«Table1»).Range
  Set myText = ThisWorkbook.Worksheets(Sheet1.Name).Range(«B4:B5»)
  Set myLogo = ThisWorkbook.Worksheets(Sheet1.Name).Shapes(«Logo_Image»)

  ‘Create an Instance of MS Word
  On Error Resume Next

        ‘Is MS Word already opened?
      Set WordApp = GetObject(class:=»Word.Application»)

        ‘Clear the error between errors
      Err.Clear

    ‘If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:=»Word.Application»)

        ‘Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox «Microsoft Word could not be found, aborting.»
        GoTo EndRoutine
      End If

  On Error GoTo 0

‘Optimize Code
  WordApp.Application.ScreenUpdating = False

  ‘Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate

  ‘Create a New Document
  Set myDoc = WordApp.Documents.Add

‘Copy/Paste Logo
  myLogo.Copy
  myDoc.Paragraphs(myDoc.Paragraphs.Count).Range.Paste

  ‘Spacing
  myDoc.Paragraphs.Add
  myDoc.Paragraphs.Add
  myDoc.Paragraphs.Add

‘Copy/Paste Text
  myText.Copy
  myDoc.Paragraphs(myDoc.Paragraphs.Count).Range.PasteAndFormat (wdFormatPlainText)

  ‘Spacing
  myDoc.Paragraphs.Add
  myDoc.Paragraphs.Add

  ‘Copy Excel Table Range
  tbl.Copy

‘Paste Table into MS Word
  myDoc.Paragraphs(myDoc.Paragraphs.Count).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False

‘Autofit Table so it fits inside Word Document
  Set WordTable = myDoc.Tables(1)
  WordTable.AutoFitBehavior (wdAutoFitWindow)

   EndRoutine:
‘Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  WordApp.Application.ScreenUpdating = True

‘Clear The Clipboard
  Application.CutCopyMode = False

End Sub

‘Copy Data from Excel
  Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects(«Table1»).Range
  Set myText = ThisWorkbook.Worksheets(Sheet1.Name).Range(«B4:B5»)
  Set myLogo = ThisWorkbook.Worksheets(Sheet1.Name).Shapes(«Logo_Image»)

‘Copy/Paste Text
  myText.Copy
  myDoc.Paragraphs(myDoc.Paragraphs.Count).Range.PasteAndFormat (wdFormatPlainText)

Start Being Creative And Automate!

Hopefully, through this example, you have gained an appreciation for the capabilities of VBA macros across multiple applications (ie Excel to MS Word).  I have been able to apply the concepts covered in this post to create monthly newsletters and reports within seconds in my financial analyst role.  I’m sure there are many other examples out there showing how Excel to Word automation can be beneficial.  If you have any examples from your own professional experience please share them with everyone in the comments section below.  I am curious about what anyone else may be automating!  I look forward to reading your thoughts!!

Download Example Excel File

If you would like to get a copy of the Excel file I used throughout this article, feel free to directly download the spreadsheet by clicking the download button below.

About The Author

Hey there! I’m Chris and I run TheSpreadsheetGuru website in my spare time. By day, I’m actually a finance professional who relies on Microsoft Excel quite heavily in the corporate world. I love taking the things I learn in the “real world” and sharing them with everyone here on this site so that you too can become a spreadsheet guru at your company.

Through my years in the corporate world, I’ve been able to pick up on opportunities to make working with Excel better and have built a variety of Excel add-ins, from inserting tickmark symbols to automating copy/pasting from Excel to PowerPoint. If you’d like to keep up to date with the latest Excel news and directly get emailed the most meaningful Excel tips I’ve learned over the years, you can sign up for my free newsletters. I hope I was able to provide you with some value today and I hope to see you back here soon!

— Chris
Founder, TheSpreadsheetGuru.com

Sub Макрос()

        Dim shape As shape
    Dim FN As String

            ‘ Полное имя файла-рисунка.
    FN = «C:UsersUserDesktopРисунок.png»

        ‘ Вставка неплавающего рисунка и превращение неплавающего рисунка в плавающий.
        ‘ При этом присваиваем рисунку имя ‘shape’ и далее в коде будем обращаться
        ‘ к рисунку по имени ‘shape’.
    Set shape = Selection.InlineShapes.AddPicture(FileName:=FN, LinkToFile:=False, _
        SaveWithDocument:=True, Range:=Selection.Range).ConvertToShape

        ‘ Здесь можете делать нужные действия с рисункам, используя имя ‘shape’.
        ‘ Например, так можно узнать левое положение рисунка.
        ‘ Информация запишется в View — Immediate Window.
    Debug.Print shape.Left

    End Sub

[свернуть]