Programme pour aficher la longitude et la latitude, la date et l horaire a partir dun fichier texte

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 853 fois - Téléchargée 20 fois

Contenu du snippet

Option Explicit

Function DerniereCellule() As Long
'cette fonction donne la ligne du dernier élément (cela permet de connaitre le nbr d'éléments à traiter)
Dim i As Long, j As Long
i = 5: j = 4
DerniereCellule = 0
Do
If Cells(i, j) <> "" Then
i = i + 1
Else
DerniereCellule = i - 1
End If
Loop Until DerniereCellule <> 0
End Function

Sub centrer()
'permet de centré les élements dans les cellules

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D5").Select

End Sub

Sub conversionbis1()
'permet de ranger les éléménts importer du fichier texte (.txt)

Range("D5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("D5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
Range("H5").Select

End Sub

Function conversion0(ByVal a As String) As Double
'permet d'effectuer le calcul intermediaire
Dim res As Double

res = (a - Int(a)) * 60

conversion0 = res

End Function

Function conversion1(ByVal a As String) As String
'cette fonction permet de convertir les longitudes et les latitudes
Dim b As Double, c As Double, d As Double

b = conversion0(a)
c = conversion0(b)
d = conversion0(c)

conversion1 = Int(a) & "°" & Int(b) & "'" & Int(c) & "," & Int(d)

End Function

Function conversion2(ByVal a As Long) As String
'cette fonction permet de convertir les horaires
Dim h As Long ' h = heures
Dim m As Long ' m = minutes
Dim S As Long ' s = secondes

h = Int(a / 10000) + 2
m = Int(a / 100) - (h - 2) * 100
S = a - (h - 2) * 10000 - m * 100

conversion2 = h & "h" & m & "min" & S & "s"

End Function

Function conversion3(ByVal b As Long) As String
'cette fonction permet de convertir les dates
Dim j As Long ' j = jour
Dim m As Long ' m = mois
Dim a As Long ' a = année

a = Int(b / 10000)
m = Int(b / 100) - a * 100
j = b - a * 10000 - m * 100

conversion3 = j & "/" & m & "/" & a

End Function

Function ReplacePointParVirgule(ByVal S As String)
Dim i As Integer
ReplacePointParVirgule = S
For i = 1 To Len(S)
If Mid(ReplacePointParVirgule, i, 1) = "." Then
Mid(ReplacePointParVirgule, i, 1) = ","
End If
Next i
End Function

Sub conversion()

Dim i As Long, la As Variant, lo As Variant
Dim horaire As Variant, dates As Variant, latitude As Variant, longitude As Variant
Dim a As Long 'a représente le nbr d'éléments à traiter
a = DerniereCellule() - 4
Dim res1 As Variant, res2 As Variant
res1 = "": res2 = ""

If Cells(5, 4).Value = "" Then
MsgBox "Copier les valeurs dans la case D5" & vbNewLine & "c'est à dire à la 5e ligne et 4e colonne "
Else
conversionbis1
End If

For i = 1 To a

lo = Cells(i + 4, 4).Value
la = Cells(i + 4, 5).Value
dates = Cells(i + 4, 6).Value
horaire = Cells(i + 4, 7).Value

lo = ReplacePointParVirgule(lo)
la = ReplacePointParVirgule(la)

If la > 0 Then
res1 = "E"
Else
res1 = "O"
End If

If lo > 0 Then
res2 = "N"
Else
res2 = "S"
End If

latitude = conversion1(la)
longitude = conversion1(lo)

Cells(i + 4, 3).Value = i
Cells(i + 4, 4).Value = longitude & """" & res2
Cells(i + 4, 5).Value = latitude & """" & res1
Cells(i + 4, 6).Value = conversion3(dates)
Cells(i + 4, 7).Value = conversion2(horaire)

Next i

centrer

End Sub

Source / Exemple :


Option Explicit

Function DerniereCellule() As Long
'cette fonction donne la ligne du dernier élément (cela permet de connaitre le nbr d'éléments à traiter)
Dim i As Long, j As Long
i = 2: j = 2
DerniereCellule = 0
Do
    If Cells(i, j) <> "" Then
        i = i + 1
    Else
        DerniereCellule = i - 1
    End If
Loop Until DerniereCellule <> 0
End Function

Sub centrer()
' permet de center les élements dans les cellules
' centrer Macro
' Macro enregistrée le 27/10/2009 par PC-STAGE2

    Cells.Select
    Range("K14").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("K15").Select
End Sub

Sub ranger()
' permet de ranger les élément dans les cellules par la fonction remplacer "+" par "+,"
' puis par la fonction convertir de placer chaque element dans une cellule
' et se termine par le remplacement des points par une virgule
' ranger Macro
' Macro enregistrée le 27/10/2009 par PC-STAGE2

    ActiveSheet.Paste
    Selection.Replace What:="+", Replacement:="+,", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.TextToColumns Destination:=Range("B3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True
    Cells.Select
    Range("K16").Activate
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Sub trier()
' permet de supprimer les lignes vides
' trier Macro
' Macro enregistrée le 27/10/2009 par PC-STAGE2
'

'
    Columns("F:F").Select
    Range("B1:I121").Sort Key1:=Range("G2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

Function conversion0(ByVal a As String) As Double
'permet d'effectuer le calcul intermediaire
Dim res As Double

res = (a - Int(a)) * 60

conversion0 = res

End Function

Function conversion1(ByVal a As String) As String
'cette fonction permet de convertir les longitudes et les latitudes
Dim b As Double, c As Double, d As Double

b = conversion0(a)
c = conversion0(b)
d = conversion0(c)

conversion1 = Int(a) & "°" & Int(b) & "'" & Int(c) & "," & Int(d)

End Function

Function conversion2(ByVal a As Long) As String
'cette fonction permet de convertir les horaires
Dim h As Long ' h = heures
Dim m As Long ' m = minutes
Dim S As Long ' s = secondes

h = Int(a / 10000) + 2
m = Int(a / 100) - (h - 2) * 100
S = a - (h - 2) * 10000 - m * 100

conversion2 = h & "h" & m & "min" & S & "s"

End Function

Function conversion3(ByVal b As Long) As String
'cette fonction permet de convertir les dates
Dim j As Long ' j = jour
Dim m As Long ' m = mois
Dim a As Long ' a = année

a = Int(b / 10000)
m = Int(b / 100) - a * 100
j = b - a * 10000 - m * 100

conversion3 = j & "/" & m & "/" & a

End Function

Sub distance()
' permet de calculer la distance
' distance Macro
' Macro enregistrée le 27/10/2009 par PC-STAGE2
'

'
    Range("H3").Select
    ActiveCell.FormulaR1C1 = _
        "=6366*ACOS(COS(RADIANS(RC[-3]))*COS(RADIANS(R[-1]C[-3]))*COS(RADIANS(RC[-5])-RADIANS(R[-1]C[-5]))+SIN(RADIANS(R[-1]C[-3]))*SIN(RADIANS(RC[-3])))*1000"
    Range("H3").Select
    Selection.AutoFill Destination:=Range("H3:H37"), Type:=xlFillDefault
    Range("H3:H37").Select
    Selection.NumberFormat = "0.00"
End Sub

Sub vitesse()
'
' vitesse Macro
' Macro enregistrée le 27/10/2009 par PC-STAGE2
'

'
    ActiveCell.FormulaR1C1 = "=RC[-1]/R2C11*3.6"
    Range("I3").Select
    Selection.AutoFill Destination:=Range("I3:I37"), Type:=xlFillDefault
    Range("I3:I37").Select
    Selection.NumberFormat = "0.00"
End Sub

Sub conversion()

Dim i As Long, nord_sud As Variant, est_ouest As Variant, distance As Variant, vitesse As Variant
Dim horaire As Variant, dates As Variant, latitude As Variant, longitude As Variant
Dim a As Long 'a représente le nbr d'éléments à traiter
a = DerniereCellule() - 6
Dim res1 As Variant, res2 As Variant, res As Variant
res1 = "": res2 = ""

If Cells(2, 2).Value = "" Then
    MsgBox "Copier les valeurs dans la case B2" & vbNewLine & "c'est à dire à la 2e ligne et 2e colonne "
Else

    ranger
    
    trier

End If

For i = 1 To a

    nord_sud = Cells(i + 1, 2).Value
    longitude = Cells(i + 1, 3).Value
    est_ouest = Cells(i + 1, 4).Value
    latitude = Cells(i + 1, 5).Value
    dates = Cells(i + 1, 6).Value
    horaire = Cells(i + 1, 7).Value
    distance = Cells(i + 1, 8).Value
    vitesse = Cells(i + 1, 9).Value
    
        
    If est_ouest > 0 Then
        res1 = "E"
    Else
        res1 = "O"
    End If
    
    If nord_sud > 0 Then
        res2 = "N"
    Else
        res2 = "S"
    End If

    latitude = conversion1(latitude)
    longitude = conversion1(longitude)
    

    Cells(i + 1, 1).Value = i
    Cells(i + 1, 2).Value = nord_sud & "" & res2
    Cells(i + 1, 3).Value = longitude & """" & res
    Cells(i + 1, 4).Value = est_ouest & "" & res1
    Cells(i + 1, 5).Value = latitude & """" & res
    Cells(i + 1, 6).Value = conversion3(dates)
    Cells(i + 1, 7).Value = conversion2(horaire)
    Cells(i + 1, 8).Value = distance
    Cells(i + 1, 9).Value = vitesse

Next i

distance

vitesse

centrer

End Sub

Conclusion :


le premier programme marche mais dans le second j' ai essayer de rajouté la distance et la vitesse mais il ya des erreur
donc je voulais savoir si on pouvait m indiquer quelques indications pouvant m'aider a terminer le programme

merci pour vos réponses

A voir également

Ajouter un commentaire Commentaires
:'( est ce que je peut voir ton code pour faire mon projet ? :'(
Messages postés
10
Date d'inscription
mardi 27 octobre 2009
Statut
Membre
Dernière intervention
30 octobre 2009

j 'ai réussi a supprimer les lignes vides
j'ai ajouté 2 colonnes en ce qui concerne le nord/sud et l'est/ouest
j 'ai ajouté une boucle me permettant de changer la valeur reçu par le fichier texte pour les 2 colonnes ajoutés
et la je suis entrain d'ajouter la distance et la vitesse
je vous tiens au courant de l'évolution
Messages postés
20
Date d'inscription
mardi 24 février 2009
Statut
Membre
Dernière intervention
8 novembre 2011

Un zip et un fichier.txt = 100000 mots....!!! BENTITI31 AU BOULOT!!!!
Messages postés
72
Date d'inscription
mercredi 29 mai 2013
Statut
Membre
Dernière intervention
15 mai 2009

excuse moi, mais ni dans ton explication ni dans ton code, je ne vois la transformation de la distance de m en km.
Dans vitesse() tu appliques 'ActiveCell.FormulaR1C1 = "=RC[-1]/R2C11*3.6"',
et dans distance() tu appliques '# ActiveCell.FormulaR1C1 = _
# "=6366*ACOS(COS(RADIANS(RC[-3]))*COS(RADIANS(R[-1]C[-3]))*COS(RADIANS(RC[-5])-RADIANS(R[-1]C[-5]))+SIN(RADIANS(R[-1]C[-3]))*SIN(RADIANS(RC[-3])))*1000"'

Peut être supprimer '*1000' tu devrais obtenir une distance en km.
Messages postés
10
Date d'inscription
mardi 27 octobre 2009
Statut
Membre
Dernière intervention
30 octobre 2009

coodonnée(43,65027;1,37436):a
(43,65038;1,37473):b

distance=6366*ACOS(COS(RADIANS(1,37436))*COS(RADIANS(1,37473))*COS(RADIANS(43,65038)-RADIANS(43,65027)+SIN(RADIANS(1,37436))*SIN(RADIANS(1,37473)))*1000
=42,88715059 mètres
voila puis après la vitesse=distance/temps entre chaque(=10s)*3.6=15,44km/h
Afficher les 17 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.