Microsoft Word VBA Expert only required (EXPERT ONLY)
Budget: $10 – $30 AUD
I have a current VBA Word Document which inserts an image and text into a new row in a table.
The image is currently inserting before the text, i want to have the text first, then the image.
Private Sub SaveCloseImportPic_Click()
Dim sItemTable As String
sItemTable = "ItemTable"
If ActiveDocument.Bookmarks.Exists(sItemTable) Then
Set tbl = ActiveDocument.Bookmarks(sItemTable).Range.Tables(1)
End If
ActiveRow = tbl.Rows.Count
With tbl.Rows(ActiveRow)
.Cells(1).Range.text = ActiveRow & "."
.Cells(2).Range.text = ItemDescriptionEntry.Value
End With
Call InsertPic
ItemDescriptionEntry.Value = "Enter Description Here"
InsertItem.Hide
End Sub
Sub FindEnd()
SendKeys ("{TAB}")
SendKeys ("{END}")
SendKeys ("{ENTER}")
Selection.EndOf Unit:=wdCell
End Sub
Sub InsertPic()
Dim intChoice As Integer
Dim strPath As String
Dim dutPic As Word.InlineShape
Dim oH As Long, oW As Long 'Original Dimensions of the image
Dim nW As Double, aspect As Double
Dim targetCell As Word.Cell
Dim oTable As Table
Dim sItemTable As String
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
Set oTable = ActiveDocument.Tables(1)
'Set Image insert location
sItemTable = "ItemTable"
If ActiveDocument.Bookmarks.Exists(sItemTable) Then
Set tbl = ActiveDocument.Bookmarks(sItemTable).Range.Tables(1)
End If
ActiveRow = tbl.Rows.Count
Set targetCell = oTable.Cell(ActiveRow, 2)
'insert the image
Set dutPic = targetCell.Range.InlineShapes.AddPicture(FileName:=strPath, _
LinkToFile:=False, SaveWithDocument:=True)
oW = dutPic.Width
oH = dutPic.Height
aspect = oW / oH 'aspect ratio
nW = aspect * 170 'new width
dutPic.Height = 170 'Desired height
dutPic.Width = nW
End Sub
The image is currently inserting before the text, i want to have the text first, then the image.
Private Sub SaveCloseImportPic_Click()
Dim sItemTable As String
sItemTable = "ItemTable"
If ActiveDocument.Bookmarks.Exists(sItemTable) Then
Set tbl = ActiveDocument.Bookmarks(sItemTable).Range.Tables(1)
End If
ActiveRow = tbl.Rows.Count
With tbl.Rows(ActiveRow)
.Cells(1).Range.text = ActiveRow & "."
.Cells(2).Range.text = ItemDescriptionEntry.Value
End With
Call InsertPic
ItemDescriptionEntry.Value = "Enter Description Here"
InsertItem.Hide
End Sub
Sub FindEnd()
SendKeys ("{TAB}")
SendKeys ("{END}")
SendKeys ("{ENTER}")
Selection.EndOf Unit:=wdCell
End Sub
Sub InsertPic()
Dim intChoice As Integer
Dim strPath As String
Dim dutPic As Word.InlineShape
Dim oH As Long, oW As Long 'Original Dimensions of the image
Dim nW As Double, aspect As Double
Dim targetCell As Word.Cell
Dim oTable As Table
Dim sItemTable As String
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
Set oTable = ActiveDocument.Tables(1)
'Set Image insert location
sItemTable = "ItemTable"
If ActiveDocument.Bookmarks.Exists(sItemTable) Then
Set tbl = ActiveDocument.Bookmarks(sItemTable).Range.Tables(1)
End If
ActiveRow = tbl.Rows.Count
Set targetCell = oTable.Cell(ActiveRow, 2)
'insert the image
Set dutPic = targetCell.Range.InlineShapes.AddPicture(FileName:=strPath, _
LinkToFile:=False, SaveWithDocument:=True)
oW = dutPic.Width
oH = dutPic.Height
aspect = oW / oH 'aspect ratio
nW = aspect * 170 'new width
dutPic.Height = 170 'Desired height
dutPic.Width = nW
End Sub