Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-02-2022, 05:06 PM
Fuzzyants Fuzzyants is offline AddPics from an Excel List, with GPS Co-ordinates Windows 11 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Novice
AddPics from an Excel List, with GPS Co-ordinates
 
Join Date: Dec 2022
Posts: 2
Fuzzyants is on a distinguished road
Default AddPics from an Excel List, with GPS Co-ordinates

Hi there,
I have been using the code from https://www.msofficeforums.com/word-...sertReportPics and it has been extremely useful. I am wondering if it is possible to pull the GPS information from the Picture itself and post it in below the picture similar to how the captions are. I am involved in a project now that would require us to label each photo with their coordinates and it has been a nightmare to manually type them all out.

Thanks!

Last edited by macropod; 12-06-2022 at 08:35 PM. Reason: Split to new thread
Reply With Quote
  #2  
Old 12-02-2022, 08:04 PM
macropod's Avatar
macropod macropod is offline AddPics from an Excel List, with GPS Co-ordinates Windows 10 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,927
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Are the GPS data in fact stored in the images? If so, under what file property/properties are they stored. If not, where are they stored?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 12-02-2022, 09:36 PM
Guessed's Avatar
Guessed Guessed is offline AddPics from an Excel List, with GPS Co-ordinates Windows 10 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,301
Guessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud of
Default

It should be possible. Are you able to work it out looking at this source?

Getting Image Properties (Exif Metadata) Using WIA in VBA
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #4  
Old 12-02-2022, 10:53 PM
Fuzzyants Fuzzyants is offline AddPics from an Excel List, with GPS Co-ordinates Windows 11 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Novice
AddPics from an Excel List, with GPS Co-ordinates
 
Join Date: Dec 2022
Posts: 2
Fuzzyants is on a distinguished road
Default

Yup! The location information is in the metadata, under GPS with the Long and Lats.
I have tried looking at some of the other VBA codes to pull this information. However, I have no idea how to incorporate it in this "picture importer". Any help is much appreciated!
Reply With Quote
  #5  
Old 12-05-2022, 08:25 PM
Guessed's Avatar
Guessed Guessed is offline AddPics from an Excel List, with GPS Co-ordinates Windows 10 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,301
Guessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud ofGuessed has much to be proud of
Default

The code provided by omegastripes on this stackoverflow thread works when the image has the GPS data on it
Excel VBA open folder and get GPS info (Exif) of each files in it (2) - Stack Overflow

The code was using late binding to make use of a library called 'Microsoft Windows Image Acquisition Library'
Code:
Sub Test()
    With CreateObject("WIA.ImageFile")
        .LoadFile "C:\Test\image.jpg"
        With .Properties("GpsLatitude").Value
            Debug.Print .Item(1).Value + .Item(2).Value / 60 + .Item(3).Value / 3600
        End With
        With .Properties("GpsLongitude").Value
            Debug.Print .Item(1).Value + .Item(2).Value / 60 + .Item(3).Value / 3600
        End With
    End With
End Sub
When I tried it on some image files without GPS data it errors so an error checker will be required.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #6  
Old 12-06-2022, 12:59 AM
macropod's Avatar
macropod macropod is offline AddPics from an Excel List, with GPS Co-ordinates Windows 10 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,927
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Fuzzyants: Do you want the output in degrees, minutes, seconds format, or as decimal degrees?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 12-06-2022, 08:29 PM
macropod's Avatar
macropod macropod is offline AddPics from an Excel List, with GPS Co-ordinates Windows 10 AddPics from an Excel List, with GPS Co-ordinates Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,927
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

The following code will extract the GPS co-ordinates, where available in the image file and insert them in the same cell as the caption, but below it. Note the changes to the original code in red.

Code:
Sub AddPics()
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim StrRpt As String, StrDocPath As String, StrPicPath As String, xlFList As String, xlCList As String
Dim iDataRow As Long, c As Long, r As Long, i As Long, j As Long, k As Long, NumCols As Long
Dim iShp As InlineShape, oTbl As Table, TblWdth As Single, RwHght As Single, ColWdth As Single
StrWkBkNm = "Workbook path & name"
StrDocPath = ActiveDocument.Path
StrRpt = Right(StrDocPath, Len(StrDocPath) - InStrRev(StrDocPath, "\"))
StrWkSht = StrRpt & " Observations"
StrPicPath = StrDocPath & "\" & StrRpt & " Report Photos\"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error GoTo ErrExit
NumCols = CLng(InputBox("How Many Columns per Row?"))
RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in centimeters (e.g. 5)?")))
On Error GoTo 0: On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit: Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    'Ensure the worksheet exists
    If SheetExists(xlWkBk, StrWkSht) = True Then
      With .Worksheets(StrWkSht)
        ' Find the last-used row in column A.
        iDataRow = .Cells(.Rows.Count, 14).End(-4162).Row ' -4162 = xlUp
        ' Capture the F/R data.
        For i = 2 To iDataRow
          ' Skip over empty fields to preserve the underlying cell contents.
          If Trim(.Range("N" & i)) <> vbNullString Then
            xlFList = xlFList & "|" & Trim(.Range("N" & i))
            xlCList = xlCList & "|" & Trim(.Range("Q" & i))
          End If
        Next
      End With
    Else
      MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation
    End If
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub
'Initialise the 'Microsoft Windows Image Acquisition' library
Dim WIAFile As Object, WIAProp As Object: Set WIAFile = CreateObject("WIA.ImageFile")
Dim StrNm As String, StrLon As String, EW As String, StrLat As String, NS As String
With ActiveDocument
  For i = 1 To .Styles.Count
    With .Styles(i)
      If .Name = "TblPic" Then bFnd = False: Exit For
    End With
  Next
  If bFnd = False Then .Styles.Add Name:="TblPic", Type:=wdStyleTypeParagraph
  With .Styles("TblPic").ParagraphFormat
    .Alignment = wdAlignParagraphCenter
    .KeepWithNext = True
    .SpaceAfter = 0
    .SpaceBefore = 0
  End With
  With .Styles("Caption")
    .ParagraphFormat.SpaceAfter = 6
    With .Font
      .Name = "Times New Roman"
      .Size = 10
      .Bold = False
    End With
    .ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(2.5), Alignment:=wdAlignTabLeft
  End With
  With .Styles("Table")
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .ParagraphFormat.SpaceAfter = 6
    With .Font
      .Name = "Times New Roman"
      .Size = 10
      .Bold = True
    End With
  End With
  'Add a 2-row by NumCols-column table to take the images
  Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
  With .PageSetup
    TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
    ColWdth = TblWdth / NumCols
  End With
  With oTbl
    .AutoFitBehavior (wdAutoFitFixed)
    .Columns.Width = ColWdth
  End With
  CaptionLabels.Add Name:="Photograph"
  'Process each file from the F/R List
  k = UBound(Split(xlFList, "|"))
  For i = 1 To k Step NumCols
    r = ((i - 1) / NumCols + 1) * 2 - 1
    'Format the rows
    Call FormatRows(oTbl, r, RwHght)
    For c = 1 To NumCols
      j = j + 1
      'Insert the Picture
      Set iShp = .InlineShapes.AddPicture( _
        FileName:=StrPicPath & Split(xlFList, "|")(j) & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range)
      With iShp
        .LockAspectRatio = True
        If (.Width < ColWdth) And (.Height < RwHght) Then
          .Width = ColWdth
          If .Height > RwHght Then .Height = RwHght
        End If
      End With
      'Get the GPS Data
      StrLat = "N/A": NS = "": StrLon = "N/A": EW = ""
      WIAFile.LoadFile StrPicPath & StrNm & ".jpg"
      With WIAFile
        If .Properties.Exists("GpsLongitudeRef") Then NS = .Properties("GpsLongitudeRef").Value
        If .Properties.Exists("GpsLongitude") Then
          With .Properties("GpsLongitude")
            StrLon = NS & .Value(1) & Chr(186) & .Value(2) & Chr(39) & .Value(3) & Chr(34)
            'StrLon = 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")
            StrLat = EW & .Value(1) & Chr(186) & .Value(2) & Chr(39) & .Value(3) & Chr(34)
            'StrLat = EW & .Value(1) + .Value(2) / 60 + .Value(3) / 3600
          End With
        End If
      End With
      'Insert the Caption & GPS Co-ordinates on the row below the picture
      With oTbl.Cell(r + 1, c).Range
        .InsertBefore vbCr
        .Characters.First.InsertCaption _
          Label:="Photograph", Title:=vbTab & Split(xlCList, "|")(j), _
          Position:=wdCaptionPositionBelow, ExcludeLabel:=False
        .Characters.First = vbNullString
        '.Characters.Last.Previous = vbNullString
        With .Characters.Last
          .Text = "GPS: " & StrLon & "; " & StrLat
          .Style = "Table"
        End With
      End With
      'Exit when we're done
      If j = k Then Exit For
    Next
    'Add extra rows as needed
    If j < k Then
      oTbl.Rows.Add
      oTbl.Rows.Add
    End If
  Next
End With
ErrExit:
Application.ScreenUpdating = True
End Sub

Function SheetExists(xlWkBk As Object, SheetName As String) As Boolean
Dim i As Long: SheetExists = False
For i = 1 To xlWkBk.Sheets.Count
  If xlWkBk.Sheets(i).Name = SheetName Then
    SheetExists = True:   Exit For
  End If
Next
End Function

Sub FormatRows(oTbl As Table, x As Long, RwHght As Single)
With oTbl
  With .Rows(x)
    .Height = RwHght
    .HeightRule = wdRowHeightExactly
    .Range.Style = "TblPic"
    .Cells.VerticalAlignment = wdCellAlignVerticalCenter
  End With
  With .Rows(x + 1)
    .Height = CentimetersToPoints(1.25)
    .HeightRule = wdRowHeightExactly
    .Range.Style = "Caption"
  End With
End With
End Sub
If you examine the added code, you'll see there are two lines related to each of the latitude & longitude outputs:
Code:
            StrLon = NS & .Value(1) & Chr(186) & .Value(2) & Chr(39) & .Value(3) & Chr(34)
            'StrLon = NS & .Value(1) + .Value(2) / 60 + .Value(3) / 3600
...
            StrLat = EW & .Value(1) & Chr(186) & .Value(2) & Chr(39) & .Value(3) & Chr(34)
            'StrLat = EW & .Value(1) + .Value(2) / 60 + .Value(3) / 3600
The active lines output them in the form:
GPS: E15015'30.780679"; S4530'15.50928"
The commented-out lines output the same data as decimal degrees.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
AddPics from an Excel List, with GPS Co-ordinates How to import list from Excel into drop-down list into word ahw Word VBA 43 02-28-2020 08:11 PM
AddPics from an Excel List, with GPS Co-ordinates Advantages of List in Excel vs List in Word? Peace Freak Excel 3 04-08-2017 06:15 PM
AddPics from an Excel List, with GPS Co-ordinates Having a Drop-down list in Word referring to an Excel list celias Word VBA 3 07-11-2016 11:40 PM
Populate Word Drop-down list with Excel column then auto fill form fields with Excel data Faldinio Word VBA 7 10-19-2014 06:03 AM
Polar Co-ordinates NWR PowerPoint 0 02-18-2013 09:48 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:30 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2023, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2023 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft