Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel exécuté si plus grand que 80

exécuté si plus grand que 80

10 réponses
Avatar
Daniel
Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:
Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci
Avatar
JLuc
Je vois pas trop ce que tu veux faire, mais voila une macro a adapter a
tes besoins

Sub deplace()
Dim pos As Integer
pos = Range("A65536").End(xlUp).Row
For x = 1 To pos
If Cells(x, 1).Value > 80 Then
Call MaMacro
End If
Next x
End Sub

JLuc

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc 'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci


Avatar
Daniel
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci





Avatar
michdenis
Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta plage de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) + 1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) + 1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news: %
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci





Avatar
Daniel
Bonsoir "mischdenis"
Voici mon fichier , la macro ne fonctionne pas .
http://cjoint.com/?kuapSsTOJc
Regarde cela.dans le module 1 est ma première macro
et module 2 la modifier
Merci

"michdenis" a écrit dans le message de news:

Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta plage
de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) + 1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) + 1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news:
%
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en
minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci










Avatar
michdenis
Bonjour Daniel,

Quelle est la cellule active lorsque tu lances ta macro ?

Pourquoi utilises-tu ceci dans ta macro : (InStr(1, ActiveCell, "E")
Aucune de tes cellules a une lettre E !


Salutations!




"Daniel" a écrit dans le message de news:
Bonsoir "mischdenis"
Voici mon fichier , la macro ne fonctionne pas .
http://cjoint.com/?kuapSsTOJc
Regarde cela.dans le module 1 est ma première macro
et module 2 la modifier
Merci

"michdenis" a écrit dans le message de news:

Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta plage
de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc As
String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) + 1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) + 1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news:
%
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en
minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci










Avatar
Daniel
Bonsoir "michdenis"

Oui je choisie la cellule active dans la colonne ou sont les pieds.
pour le E ces = EST , OUEST ,NORD,SUD point cardinaux.
Merci

"michdenis" a écrit dans le message de news:
%23N%
Bonjour Daniel,

Quelle est la cellule active lorsque tu lances ta macro ?

Pourquoi utilises-tu ceci dans ta macro : (InStr(1, ActiveCell, "E")
Aucune de tes cellules a une lettre E !


Salutations!




"Daniel" a écrit dans le message de news:

Bonsoir "mischdenis"
Voici mon fichier , la macro ne fonctionne pas .
http://cjoint.com/?kuapSsTOJc
Regarde cela.dans le module 1 est ma première macro
et module 2 la modifier
Merci

"michdenis" a écrit dans le message de news:

Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta plage
de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion
de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news:
%
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en
minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci















Avatar
michdenis
Bonjour Daniel,

Cellule de départ : donne moi l'adresse de la cellule comme : Cellule B1

Comme ta procédure bloque à l'exécution, tu peux m'envoyer dans ma boîte de courriel, un exemplaire de ton fichier après l'exécution
de ta macro pour savoir et voir les résultats attendus et souhaités.


Salutations!


"Daniel" a écrit dans le message de news:
Bonsoir "michdenis"

Oui je choisie la cellule active dans la colonne ou sont les pieds.
pour le E ces = EST , OUEST ,NORD,SUD point cardinaux.
Merci

"michdenis" a écrit dans le message de news:
%23N%
Bonjour Daniel,

Quelle est la cellule active lorsque tu lances ta macro ?

Pourquoi utilises-tu ceci dans ta macro : (InStr(1, ActiveCell, "E")
Aucune de tes cellules a une lettre E !


Salutations!




"Daniel" a écrit dans le message de news:

Bonsoir "mischdenis"
Voici mon fichier , la macro ne fonctionne pas .
http://cjoint.com/?kuapSsTOJc
Regarde cela.dans le module 1 est ma première macro
et module 2 la modifier
Merci

"michdenis" a écrit dans le message de news:

Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta plage
de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion
de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news:
%
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en
minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci















Avatar
michdenis
Fichier retourné dans ta bal.


Salutations!


"Daniel" a écrit dans le message de news:
Bonsoir "michdenis"

Oui je choisie la cellule active dans la colonne ou sont les pieds.
pour le E ces = EST , OUEST ,NORD,SUD point cardinaux.
Merci

"michdenis" a écrit dans le message de news:
%23N%
Bonjour Daniel,

Quelle est la cellule active lorsque tu lances ta macro ?

Pourquoi utilises-tu ceci dans ta macro : (InStr(1, ActiveCell, "E")
Aucune de tes cellules a une lettre E !


Salutations!




"Daniel" a écrit dans le message de news:

Bonsoir "mischdenis"
Voici mon fichier , la macro ne fonctionne pas .
http://cjoint.com/?kuapSsTOJc
Regarde cela.dans le module 1 est ma première macro
et module 2 la modifier
Merci

"michdenis" a écrit dans le message de news:

Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta plage
de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion
de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news:
%
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que 80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en
minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci















Avatar
Daniel
Bonsoir "michdenis"

Super, je l'ai adapter a mon fichier maitre et tous va bien .

GROS MERCI

"michdenis" a écrit dans le message de news:

Fichier retourné dans ta bal.


Salutations!


"Daniel" a écrit dans le message de news:

Bonsoir "michdenis"

Oui je choisie la cellule active dans la colonne ou sont les pieds.
pour le E ces = EST , OUEST ,NORD,SUD point cardinaux.
Merci

"michdenis" a écrit dans le message de news:
%23N%
Bonjour Daniel,

Quelle est la cellule active lorsque tu lances ta macro ?

Pourquoi utilises-tu ceci dans ta macro : (InStr(1, ActiveCell, "E")
Aucune de tes cellules a une lettre E !


Salutations!




"Daniel" a écrit dans le message de news:

Bonsoir "mischdenis"
Voici mon fichier , la macro ne fonctionne pas .
http://cjoint.com/?kuapSsTOJc
Regarde cela.dans le module 1 est ma première macro
et module 2 la modifier
Merci

"michdenis" a écrit dans le message de news:

Bonjour Daniel,

J'ai fait une tentative pour t'aider à faire une boucle sur ta plage.
Comme tu n'as pas défini ni le nom de ta feuille ni l'étendue de ta
plage
de cellules concernées,

Voici une idée de ce que cela pourrait donner :

Tu auras sûrement des corrections à effectuer !

'---------------------------------
Sub insérer_Long_Lat() 'selectionner la cellule de pieds

Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String

Dim Rg As Range, C As Range
With Worksheets("Feuil1") 'à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg
Lat1 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon1 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
Pied1 = C.Offset(0, 1).Value
If C.Offset(1) = "" Then
C = Pied1 / 2
Exit Sub
End If
Set C = C.Offset(1)
Lat2 = Left(C, InStr(1, C, "E") + InStr(1, C, "W") - 2)
Lon2 = Right(C, Len(C) - (InStr(1, C, "E") + InStr(1, C, "W")) +
1)
PiedCalc = Pied1 / 2
C.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
C.Insert Shift:=xlDown 'Conversion de Latitude 1 en minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion
de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
C.Value = LatCalc & " " & LonCalc
C.Offset(0, 1) = PiedCalc
End If
Next
Set Rg = Nothing :Set C = Nothing
End Sub
'---------------------------------


Salutations!



"Daniel" a écrit dans le message de news:
%
Bonjour "michdenis"
La macros me permet de trouver un point GPS entre deux point
et de diviser le nombre de pieds entre les deux.

avant l'exécution:
N45.88796 W73.47503 84
N45.88774 W73.47506 81
N45.88753 W73.47508 78
N45.88732 W73.47511 76

après:
N45.88796 W73.47503 42
N45.88785 W73.47504 42
N45.88774 W73.47506 40;5
N45.88763 W73.47507 40;5
N45.88753 W73.47508 78
N45.88732 W73.47511 76
N45.88712 W73.47513 72

Ca va pour l'explication .

Merci


"michdenis" a écrit dans le message de news:

Bonjour Daniel,

Et si tu nous expliquais ce que fait ta macro. Je crois qu'en quelques
lignes tu peux nous donner un aperçu de sa fonctionnalité.


Salutations!



"Daniel" a écrit dans le message de news:

Bonjour à Tous

J'ai une macro que je voudrait exécuter,
si le chiffre est plus grand que 80 et si plus petit decendre d'une
cellule
pour vérifier encore si plus grand.
La macros decend d'une cellule a la fin.
Car dans la liste de plus de 2000 ligne je veut exécuter "ma-macro"
sur tout les chiffre plus haut que 80.
Comment écrire la procédure ?
Voici la macro que je veut exécuter avec la condition plus grand que
80.

Sub insérer_Long_Lat() 'selectionner la cellule de pieds
ActiveCell(1, 0).Select
Dim Lat1 As String, Lat2 As String, Lon1 As String, Lon2 As String
Dim LatMin1 As Single, LatMin2 As Single
Dim Pied1 As Integer, PiedCalc As Single
Dim LonMin1 As Single, LonMin2 As Single, LatCalc As String, LonCalc
As
String
Lat1 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon1 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
Pied1 = ActiveCell.Offset(0, 1).Value
ActiveCell.Resize(1, 2).Select
Selection.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 1).Value = Pied1 / 2
Exit Sub
End If
Lat2 = Left(ActiveCell.Value, InStr(1, ActiveCell, "E") + InStr(1,
ActiveCell, "W") - 2)
Lon2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - (InStr(1,
ActiveCell, "E") + InStr(1, ActiveCell, "W")) + 1)
PiedCalc = Pied1 / 2
ActiveCell.Offset(-1, 1).Value = PiedCalc
'ActiveCell.EntireRow.Insert
Selection.Insert Shift:=xlDown 'Conversion de Latitude 1 en
minutes
LatMin1 = Right(Lat1, 8)
If Left(Lat1, 1) = "S" Then
LatMin1 = LatMin1 * -1
End If 'Conversion de Latitude 2 en minutes
LatMin2 = Right(Lat2, 8)
If Left(Lat2, 1) = "S" Then
LatMin2 = LatMin2 * -1
End If 'calcul moyenne latitude
If (LatMin1 + LatMin2) / 2 >= 0 Then
LatCalc = "N"
Else
LatCalc = "S"
LatMin1 = LatMin1 * -1
LatMin2 = LatMin2 * -1
End If
LatCalc = LatCalc & Round((LatMin1 + LatMin2) / 2, 5)
If Len(LatCalc) = 8 Then LatCalc = LatCalc & "0" 'Conversion de
longitude 1 en minutes
LonMin1 = Right(Lon1, 8)
If Left(Lon1, 1) = "W" Then
LonMin1 = LonMin1 * -1
End If 'Conversion de longitude 2 en minutes
LonMin2 = Right(Lon2, 8)
If Left(Lon2, 1) = "W" Then
LonMin2 = LonMin2 * -1
End If 'calcul moyenne longitude
If (LonMin1 + LonMin2) / 2 >= 0 Then
LonCalc = "E"
Else
LonCalc = "W"
LonMin1 = LonMin1 * -1
LonMin2 = LonMin2 * -1
End If
LonCalc = LonCalc & Round((LonMin1 + LonMin2) / 2, 5)
If Len(LonCalc) = 8 Then LonCalc = LonCalc & "0"
ActiveCell.Value = LatCalc & " " & LonCalc
ActiveCell.Offset(0, 1) = PiedCalc
Selection.Offset(1, 0).Select
ActiveCell(1, 2).Select
End Sub

Merci