如何将三张图片插入到表格中的指定三个单元格中

时间:2015-12-10 13:39:04

标签: vba ms-word word-vba

我需要以相应的方式将三张图片插入到一个表格中的三个指定单元格中(第二行,第1,3和5列)。我设法只将一张图片放到一个单元格中:

Sub insertSig() ' works only for one picture & one cell only
  Dim fd As FileDialog
  Dim oTable As Table
  Dim vrtSelectedItem As Variant

  Set oTable = ActiveDocument.Tables(3)

  Set fd = Application.FileDialog(msoFileDialogFilePicker)

  With fd
   .Title = "Select image files and click OK"
   .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
   .FilterIndex = 2

   If .Show = -1 Then

     oTable.Cell(2, 1).Select

     For Each vrtSelectedItem In .SelectedItems

      With Selection
        .InlineShapes.AddPicture FileName:= _
          vrtSelectedItem _
          , LinkToFile:=False, SaveWithDocument:=True, _
          Range:=Selection.Range
        .MoveRight Unit:=wdCell
      End With
    Next vrtSelectedItem

   End If

 End With

 MsgBox "Signature Inserted"

End Sub

但我需要将选定的三张图片插入原始2,第1,3和5列。

我想代码应该是这样的:

Sub insertSig2()
  Dim fd As FileDialog
  Dim oTable As Table
  'Dim oTable As Array  
  Dim vrtSelectedItem As Variant

  Dim Cell1 As Variable
  Dim Cell2 As Variable  
  Dim Cell3 As Variable
  Dim i As Integer
  Dim iCells As Cells

  Set Cell1 = oTable.Cell(2, 1).Select
  Set Cell2 = oTable.Cell(2, 3).Select
  Set Cell3 = oTable.Cell(2, 5).Select

  Set oTable = ActiveDocument.Tables(3)

  Set fd = Application.FileDialog(msoFileDialogFilePicker)

  With fd
    .Title = "Select image files and click OK"
    .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"   
    .FilterIndex = 2

    If .Show = -1 Then

      For Each iCell In iCells
      'or For i = Cell1 To Cell3

        For Each vrtSelectedItem In .SelectedItems
          With Selection
           .InlineShapes.AddPicture FileName:= _
             vrtSelectedItem _
            , LinkToFile:=False, SaveWithDocument:=True, _
            Range:=Selection.Range
          .MoveRight Unit:=wdCell
         End With
       Next vrtSelectedItem

     Next iCell
   End If
  End With
  MsgBox "Signature Inserted"
End Sub

我正在考虑像这样的数组函数

oTable.Range(Cell(2, 1), Cell(2, 3), Cell(2, 5)).Select

但我也想不出来。

2 个答案:

答案 0 :(得分:1)

您的想法很好,但是因为您在Word文档中只能有一个选择这一事实而受到阻碍。但是,您可以根据需要使用尽可能多的Range对象。所以:

Dim Cell1 As Word.Range
Dim Cell2 As Word.Range  
Dim Cell3 As Word.Range

Set Cell1 = oTable.Cell(2, 1).Range
Set Cell2 = oTable.Cell(2, 3).Range
Set Cell3 = oTable.Cell(2, 5).Range

您可以将这些分配给数组并循环它们 - 同时循环选择对话框(不需要额外的嵌套循环)。或者您可以使用对话框选择执行类似的操作:

ActiveDocument.InlineShapes.AddPicture FileName:= _
         .SelectedItems(1) _
        , LinkToFile:=False, SaveWithDocument:=True, _
        Range:=Cell1
ActiveDocument.InlineShapes.AddPicture FileName:= _
         .SelectedItems(2) _
        , LinkToFile:=False, SaveWithDocument:=True, _
        Range:=Cell2
ActiveDocument.InlineShapes.AddPicture FileName:= _
         .SelectedItems(3) _
        , LinkToFile:=False, SaveWithDocument:=True, _
        Range:=Cell3

答案 1 :(得分:0)

您可以使用以下几行内容 - 根据您想要指定替换单元格列表的具体内容,可能会发生一些变化:

Sub insertSigs() 

' Specify the number of cells
Const pictureCount As Integer = 3
Dim fd As FileDialog
Dim i As Integer
Dim oTable As Table
' NB, VBA actually creates an array with elements 0,..,pictureCount
Dim targetCell(pictureCount) As Word.Cell

' Specify the table
Set oTable = ActiveDocument.Tables(3)

' Populate our array of cells.
' We don't need to select anything
' But trying to store the .Ranges rather than the
' Cell object references probably won't work well
Set targetCell(1) = oTable.Cell(2, 1)
Set targetCell(2) = oTable.Cell(2, 3)
Set targetCell(3) = oTable.Cell(2, 5)

Set fd = Application.FileDialog(msoFileDialogFilePicker)

  With fd
   .Title = "Select image files and click OK"
   .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
   .FilterIndex = 2

  If .Show = -1 Then

    For i = 1 To IIf(.SelectedItems.Count < pictureCount, .SelectedItems.Count, pictureCount)
      ' use the Cell Range rather than selecting
      targetCell(i).Range.InlineShapes.AddPicture _
        FileName:=.SelectedItems(i), _
        LinkToFile:=False, _
        SaveWithDocument:=True
    Next
  End If

End With

MsgBox "Signatures Inserted"

End Sub