Dim wdTable As Object Dim objWrdDoc As Object Dim strFile As String Dim p As InlineShape, t As Object Dim pShape As Object
On Error Resume Next strFile = ".... путь к файлу WORD ...." 'прописать путь к Документу Set objWrdApp = GetObject(, "Word.Application") 'пытаемся подключится к объекту Word If objWrdApp Is Nothing Then Set objWrdApp = CreateObject("Word.Application") 'если приложение закрыто - создаем новый экземпляр Set objWrdDoc = objWrdApp.Documents.Open(strFile) 'открываем документ Word - документ с таким именем должен существовать objWrdApp.Visible = True End If Set objWrdDoc = objWrdApp.Documents.Open(strFile) On Error GoTo 0
Set WdRange = objWrdDoc.Content Set wdTable = WdRange.Tables(1)
Set p = wdTable.Rows(1).Cells(1).Range.InlineShapes.AddPicture(".... путь к картинке ....", False, True) 'прописать путь к картинке 'вставил абы куда, куда получилось, хотелось бы вставить сразу куда нужно p.ScaleWidth = 20 p.ScaleHeight = 20 Set t = p.ConvertToShape t.WrapFormat.Type = wdWrapNone
t.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage t.RelativeVerticalPosition = wdRelativeVerticalPositionPage t.Left = 260 'значения, конкретно под этот случай t.Top = 370 'значения, конкретно под этот случай
End Sub
[/vba]
Помогите, пожалуйста, с такой проблемой:
1) как "привязать" путь файла WORD, в который будет вставляться картинка, к ячейке, к примеру, F1 файла EXCEL 2) как "привязать" путь файла JPG, которая будет вставляться в файл, к ячейке, к примеру, файла EXCEL
Вопрос связан с тем, что в данных ячейках пути файлов могут меняться в зависимости от прописанной формулы
Dim wdTable As Object Dim objWrdDoc As Object Dim strFile As String Dim p As InlineShape, t As Object Dim pShape As Object
On Error Resume Next strFile = ".... путь к файлу WORD ...." 'прописать путь к Документу Set objWrdApp = GetObject(, "Word.Application") 'пытаемся подключится к объекту Word If objWrdApp Is Nothing Then Set objWrdApp = CreateObject("Word.Application") 'если приложение закрыто - создаем новый экземпляр Set objWrdDoc = objWrdApp.Documents.Open(strFile) 'открываем документ Word - документ с таким именем должен существовать objWrdApp.Visible = True End If Set objWrdDoc = objWrdApp.Documents.Open(strFile) On Error GoTo 0
Set WdRange = objWrdDoc.Content Set wdTable = WdRange.Tables(1)
Set p = wdTable.Rows(1).Cells(1).Range.InlineShapes.AddPicture(".... путь к картинке ....", False, True) 'прописать путь к картинке 'вставил абы куда, куда получилось, хотелось бы вставить сразу куда нужно p.ScaleWidth = 20 p.ScaleHeight = 20 Set t = p.ConvertToShape t.WrapFormat.Type = wdWrapNone
t.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage t.RelativeVerticalPosition = wdRelativeVerticalPositionPage t.Left = 260 'значения, конкретно под этот случай t.Top = 370 'значения, конкретно под этот случай
End Sub
[/vba]
Помогите, пожалуйста, с такой проблемой:
1) как "привязать" путь файла WORD, в который будет вставляться картинка, к ячейке, к примеру, F1 файла EXCEL 2) как "привязать" путь файла JPG, которая будет вставляться в файл, к ячейке, к примеру, файла EXCEL
Вопрос связан с тем, что в данных ячейках пути файлов могут меняться в зависимости от прописанной формулы
Dim wdTable As Object Dim objWrdDoc As Object Dim strFile As String Dim p As InlineShape, t As Object Dim pShape As Object
On Error Resume Next
strFile = Range("E8").Value 'путь к документу (можно "d:\...\Документ.docx") Set objWrdApp = GetObject(, "Word.Application") 'пытаемся подключится к объекту Word If objWrdApp Is Nothing Then Set objWrdApp = CreateObject("Word.Application") 'если приложение закрыто - создаем новый экземпляр Set objWrdDoc = objWrdApp.Documents.Open(strFile) 'открываем документ Word - документ с таким именем должен существовать objWrdApp.Visible = True End If Set objWrdDoc = objWrdApp.Documents.Open(strFile) On Error GoTo 0
Set WdRange = objWrdDoc.Content Set wdTable = WdRange.Tables(1)
Set p = wdTable.Rows(1).Cells(1).Range.InlineShapes.AddPicture(Range("C11").Value, False, True) ' путь к картинке (можно "d:\...\печать.png")
'вставка в документ p.ScaleWidth = 20 p.ScaleHeight = 20 Set t = p.ConvertToShape t.WrapFormat.Type = wdWrapNone
t.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage t.RelativeVerticalPosition = wdRelativeVerticalPositionPage t.Left = 260 'значения, конкретно под этот случай t.Top = 370 'значения, конкретно под этот случай
End Sub
[/vba]
может кому пригодится сам разобрался
[vba]
Код
Sub InsertPicture()
Dim wdTable As Object Dim objWrdDoc As Object Dim strFile As String Dim p As InlineShape, t As Object Dim pShape As Object
On Error Resume Next
strFile = Range("E8").Value 'путь к документу (можно "d:\...\Документ.docx") Set objWrdApp = GetObject(, "Word.Application") 'пытаемся подключится к объекту Word If objWrdApp Is Nothing Then Set objWrdApp = CreateObject("Word.Application") 'если приложение закрыто - создаем новый экземпляр Set objWrdDoc = objWrdApp.Documents.Open(strFile) 'открываем документ Word - документ с таким именем должен существовать objWrdApp.Visible = True End If Set objWrdDoc = objWrdApp.Documents.Open(strFile) On Error GoTo 0
Set WdRange = objWrdDoc.Content Set wdTable = WdRange.Tables(1)
Set p = wdTable.Rows(1).Cells(1).Range.InlineShapes.AddPicture(Range("C11").Value, False, True) ' путь к картинке (можно "d:\...\печать.png")
'вставка в документ p.ScaleWidth = 20 p.ScaleHeight = 20 Set t = p.ConvertToShape t.WrapFormat.Type = wdWrapNone
t.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage t.RelativeVerticalPosition = wdRelativeVerticalPositionPage t.Left = 260 'значения, конкретно под этот случай t.Top = 370 'значения, конкретно под этот случай