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
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.