Les coordonnées GPS au format Google Maps seront appliquées aux fichiers séléctionnés#imageconversion@disablenosel@filesonly@script vbscript' v2016.11.06' Here is a script button that will apply GPS coordinates copied from Google Maps to the selected image files.' Source and Update: https://resource.dopus.com/viewtopic.php?f=35&t=27486Function OnClick(ByRef ClickData) ' Clear the log output' DOpus.ClearOutput ' ============================================================================ ' INITIATE VARIABLES & OBJECT ' ============================================================================ Match = 0 Set cmd = ClickData.Func.command Set srce = ClickData.Func.sourcetab Dim GpsInput ' Dialog default values Title = "Coordonnées GPS" Message = "Coller les coordonnées que vous avez copiées depuis Google Maps."& vbCrLf & vbCrLf &"Le format valide est par ex: 47.338388, 0.990228" Buttons = "&OK|&Annuler" Icon = "question" ' ============================================================================ ' FILTER FILES TO BE PROCESSED ' ============================================================================' DOpus.Output "Selected files BEFORE filter : " & srce.selected_files.count' DOpus.Output "Files that will actually be processed BEFORE filter : " & cmd.files.count cmd.ClearFiles ' All items are removed from the collection so only image files will be added next' DOpus.Output ""' DOpus.Output "FILTERING…"' DOpus.Output "" n = 1 For Each f In srce.selected_files ' If a selected file can handle GPS metadata, it will be added to files to process If (f.metadata = "image") then cmd.AddFile(f)' DOpus.Output n & ". """ & f.name & """ will be processed" End if n = n+1 Next' DOpus.Output "" ' Select files that will actually be processed cmd.RunCommand("Select FROMSCRIPT DESELECTNOMATCH MAKEVISIBLE") srce.Update ' Synchronize changes made by the previous select command to the sourcetab object. It can be useful if you need to use this object later.' DOpus.Output "Selected files AFTER filter : " & srce.selected_files.count' DOpus.Output "Files that will actually be processed AFTER filter : " & cmd.files.count ' ============================================================================ ' RETRIEVE GPS COORDS ' ============================================================================ ' Check if at least 1 file is selected to continue else warn and exit. If cmd.files.count < 1 Then Set dlg = ClickData.Func.Dlg dlg.Request "Aucun fichier sélectionné ou valide." & vbCrLf & "Veuillez sélectionner au moins 1 fichier image puis relancer la commande.", "OK" Set dlg = Nothing ' destroy dialog Exit Function End If ' Check if clipboard contains valid coordinates to apply If DOpus.GetClipFormat = "text" Then GpsInput = DOpus.GetClip' DOpus.Output "GpsInput from CP : """ & GpsInput & """" ' Check if the clipboard content is a valid GPS coordinates Set re = New RegExp re.IgnoreCase = True ' No Case-sensitive matching. re.Global = False ' Only first match will be matched re.Pattern = "^(-?[1-8]?\d(?:\.\d{1,18})?|90(?:\.0{1,18})?),\s*?(-?(?:1[0-7]|[1-9])?\d(?:\.\d{1,18})?|180(?:\.0{1,18})?)$" Set matches = re.Execute(GpsInput) If matches.Count = 1 Then ' Case if values contains valid coordinates Match = 1' DOpus.Output "GpsInput from CP is VALID"' DOpus.Output "Found " & matches.Count & " matches" & vbCRLF & "Match value : " & matches.Item(0).Value Lat = matches.Item(0).SubMatches(0) Lon = matches.Item(0).SubMatches(1)' DOpus.Output "Latitude = " & Lat & vbCrLf & "Longitude = " & Lon Else ' Case if clipboard doesn't contain valid coordinates ' Prompt the user to enter values, ask coordinates until they are valid Do While Match = 0 ' Create 1st Dialog object. Set dlg = DOpus.Dlg ' Initialise the object to display a message with 2 buttons and 1 input box dlg.Window = DOpus.Listers(0) dlg.title = Title dlg.message = Message dlg.buttons = Buttons dlg.icon = Icon dlg.max = 128 ' enable the text field ret = dlg.Show ' Show the dialog ' DOpus.Output "Dialog.Show returned " & ret ' DOpus.Output "The string you entered was " & dlg.input If ret = 0 then ' When user cancel action, just quit the script Exit Function End If GpsInput = dlg.input ' DOpus.Output "GpsInput from prompt : """ & GpsInput & """" Set dlg = Nothing ' destroy 1st dialog prompt ' Check if the input content is a valid GPS coordinates Set re = New RegExp re.IgnoreCase = True ' No Case-sensitive matching. re.Global = False ' Only first match will be matched re.Pattern = "^(-?[1-8]?\d(?:\.\d{1,18})?|90(?:\.0{1,18})?),\s+?(-?(?:1[0-7]|[1-9])?\d(?:\.\d{1,18})?|180(?:\.0{1,18})?)$" Set matches = re.Execute(GpsInput) If matches.Count = 1 Then ' Case if values contains valid coordinates Match = 1 ' DOpus.Output "GpsInput from CP is VALID" ' DOpus.Output "Found " & matches.Count & " matches" & vbCRLF & "Match value : " & matches.Item(0).Value Lat = matches.Item(0).SubMatches(0) Lon = matches.Item(0).SubMatches(1) ' DOpus.Output "Latitude = " & Lat & vbCrLf & "Longitude = " & Lon Else ' If fomat is invalid, warn the user and ask if he wants to retry or cancel. ' Just change default values for the 1st dialog that will pop up again because the loop Title = "Format Invalide" Message = "Le format des coordonnées entrées n'est pas valide."& vbCrLf & vbCrLf &"Veuillez recommencer." Icon = "warning" ' Clear the log output' DOpus.ClearOutput End If Loop End If End If ' ============================================================================ ' APPLY GPS DATA ' ============================================================================' DOpus.Output "Latitude = " & Lat & vbCrLf & "Longitude = " & Lon' DOpus.Output "Number of selected files that the script will apply GPS : " & ClickData.Func.sourcetab.selected.count cmd.RunCommand("SetAttr META gpslatitude:"&Lat&" gpslongitude:"&Lon&"")End Function