Belinda,
Paul has provided a less complicated method of extracting the GPS data. I have tried to tailor his code more to your specific requirements:
Code:
Option Explicit
Sub AddPicsWithGPSCoordinates()
Dim lngIndex As Long, oShp As InlineShape
Dim oTbl As Table, sngTblWidth As Single, strGPS As String, sngRowHght As Single, sngColWdth As Single
Application.ScreenUpdating = False
With ActiveDocument.PageSetup
sngTblWidth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
End With
'These are fixed values in points. Suited for landscape oriented photos. Modify here or use the original input box method.
sngColWdth = 320
sngRowHght = 200
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then
Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=2)
With oTbl
.AutoFitBehavior wdAutoFitFixed
.TopPadding = 2
.BottomPadding = 2
.LeftPadding = 0
.RightPadding = 0
.Spacing = 0
.Columns(2).Width = sngTblWidth - sngColWdth
.Columns(1).Width = sngColWdth
.Borders.Enable = True
With .Rows(1)
.Cells(2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Height = sngRowHght
.HeightRule = wdRowHeightExactly
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
End With
End With
For lngIndex = 1 To .SelectedItems.Count
'Insert the Picture
Set oShp = ActiveDocument.InlineShapes.AddPicture( _
FileName:=.SelectedItems(lngIndex), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oTbl.Cell(lngIndex, 1).Range)
With oShp
.LockAspectRatio = True
If (.Width < sngColWdth) And (.Height < sngRowHght) Then
.Width = sngColWdth
If .Height > sngRowHght Then .Height = sngRowHght
End If
End With
'Get the GPS data
strGPS = fcnGetGPSInfo(.SelectedItems(lngIndex))
oTbl.Cell(lngIndex, 2).Range.Text = "Location" & vbCr & strGPS
oTbl.Rows.Add
Next lngIndex
oTbl.Rows.Last.Delete
End If
End With
ErrExit:
Application.ScreenUpdating = True
End Sub
Function fcnGetGPSInfo(strPath) As String
'You will need to set a reeference to Microsoft Windows Image Acquisition library
Dim WIAFile As Object, WIAProp As Object
Dim strLat As String, NS As String, strLong As String, EW As String
fcnGetGPSInfo = "Not" & vbCr & "Defined"
strLat = "": NS = "": strLong = "": EW = ""
Set WIAFile = CreateObject("WIA.ImageFile")
WIAFile.LoadFile strPath
With WIAFile
If .Properties.Exists("GpsLongitudeRef") Then NS = .Properties("GpsLongitudeRef").Value
If .Properties.Exists("GpsLongitude") Then
With .Properties("GpsLongitude")
'Seconds rounded to four decimal places
strLong = NS & .Value(1) & Chr(186) & .Value(2) & Chr(39) & Format(.Value(3), "0.0000") & Chr(34)
'strLong = NS & .Value(1) + .Value(2) / 60 + .Value(3) / 3600
End With
End If
If .Properties.Exists("GpsLatitudeRef") Then EW = .Properties("GpsLatitudeRef").Value
If .Properties.Exists("GpsLatitude") Then
With .Properties("GpsLatitude")
'Seconds rounded to four decimal places
strLat = EW & .Value(1) & Chr(186) & .Value(2) & Chr(39) & Format(.Value(3), "0.0000") & Chr(34)
'StrLat = EW & .Value(1) + .Value(2) / 60 + .Value(3) / 3600
End With
End If
End With
If strLat <> vbNullString Then fcnGetGPSInfo = strLat & vbCr & strLong
Set WIAFile = Nothing
lbl_Exit:
Exit Function
End Function