documentation sur les programmes vba excel de traitement des profils

DOCUMENTATION SUR LES PROGRAMMES
VBA EXCEL
DE TRAITEMENT DES PROFILS
JULES FLEURY 1
CEREGE
mardi 31 mai 2011
1
Jules Fleury. Europôle de l’Arbois, CEREGE, BP80,13545 Aix en Provence Cedex 4. Tel : 04 42 97 15 76.
Email : fleury@cerege.fr

SOMMAIRE
Programmes Excel ................................................................................................................. 3
a. Presentation ..................................................................................................................... 3
b. Traitement des profils en travers en fichier txt ............................................................... 3
c. Traitement des profils en travers en fichier Excel ........................................................... 5
d. Calcul du profil en long à partir des profils en travers .................................................... 7
e. Comparaison des profils en long ..................................................................................... 8
B. Liste des programmes ....................................................................................................... 10
C. Annexes : Code ................................................................................................................ 11
a. Traitement profils travers txt ......................................................................................... 11
b. Traitement profils travers xls ........................................................................................ 17
c. Calcul profils long ......................................................................................................... 20
d. Comparaison profils long .............................................................................................. 23

Documentation des programmes du SIG CAMARGUE
Programmes Excel
a. Presentation
Ces programmes sont écrits en Visual Basic for Application et nécessitent EXCEL.
Ce sont des macros et ils sont accessibles par une barre d’outil personnalisée.
Ils sont destinés à traiter des profils en travers de manière à créer des fichiers x y z et à
calculer les profils en long correspondants.
Figure 1 : Interface des outils de traitements de profils dans excell
b. Traitement des profils en travers en fichier txt
Les fichiers en entrée sont des profils en travers sous forme de fichiers texte .txt contenant
l’identifiant du profil, la date, la distance à l’origine et la côte (Figure 2).
Figure 2 : Fichier texte d’un profil en travers
Notre programme permet la conversion de ce type de fichier (il fonctionne en batch) en fichier
x y z. Pour cela, on utilise un fichier contenant les coordonnées du début et de la fin de chaque
profil.
Figure 3 : Fichier Excel contenant les coordonnées de début et de fin de chaque profil en travers. Les
attributs LOC3, CHUT, OUVR, DISTAPP ne sont pas utiles dans le cas général.
Des calculs trigonométriques permettent de retrouver les coordonnées de chaque point du
profil.
Jules Fleury / CEREGE 31/05/2011 3

Documentation des programmes du SIG CAMARGUE
Figure 4 : Exemple de fichier en sortie d’un traitement du profil en travers
On voit que le fichier en sortie, nommé p_date_nomprofil.xls, contient les coordonnées en
Lambert III des extremités du profil, le nom du profil (ici 293), la date du levé (ici 1964), puis
une table avec la distance à l’origine en rive droite, la côte du point, les coordonnées en
Lambert III et le nom du PK.
Si l’on utilise en entrée un ensemble de profils en travers de la même date (traitement en
batch), alors un fichier de synthèse, nomé p_date_s.xls, est aussi généré.
Figure 5 : Exemple de fichier synthétique créé à partir du traitement en batch d’un ensemble de profil en
travers.
Ce fichier synthétique n’est qu’une table contenant la distance à l’origine en rive droite, la
côte du point, les coordonnées en Lambert III et le nom du PK.
Il est ensuite aisé d’exporter ce fichier vers ArcGIS pour créer un fichier de polyligne3D.
Jules Fleury / CEREGE 31/05/2011 4

Documentation des programmes du SIG CAMARGUE
Figure 6 : Exemple de résultat du traitement de profils en travers
Installation
1. Ouvrir VBA dans Excel
2. Copier le code dans un module
3. Nommer le module selon vos aspirations
4. Fermer VBA
5. Eventuellement rajouter un bouton dans Excel lié à la macro.
Dans le menu Outils, allez dans Personnalisation puis dans l’onglet Commandes et la
catégorie Macros. Cliquez dans Bouton personnalisé et le faire glisser vers une barre
d’outil. Ensuite par un clic droit sur le bouton faire Affecter une macro.
Utilisation
Ce programme s’exécute simplement en cliquant sur le bouton affecté à la macro ou en
utilisant la fonction Executer une macro dans le menu Outils.
PRECAUTIONS D’EMPLOI
• Il faut modifier dans le code le chemin pour le fichier x y z en sortie.
• Si le(s) fichier txt en entrée n’est pas au format présenté Figure 2, avec ligne de
titre et séparateurs, alors il faut modifier le code pour prendre en compte le
format. Une autre solution si vous ne voulez pas rentrer dans le code et que
vous avez peu de fichiers à traiter est de mettre en forme manuellement chacun
de vos fichiers.
• Il faut que le fichier contenant les coordonnées des extrémités du profil soit
ouvert, soit nommé XY PK.xls, et possède exactement la même structure que le
fichier présenté Figure 3.
• Si vous traitez des fichiers en batch, il faut créer et ouvrir le fichier de synthèse
que vous nommerez p_date_s.xls, avec la ligne de titre tel que présenté Figure
5.
c. Traitement des profils en travers en fichier Excel
Présentation
Le principe est le même que présenté supra, sauf que le fichier en entrée est au format Excel
et contient tous les profils en travers les uns à la suite des autres.
Jules Fleury / CEREGE 31/05/2011 5

Documentation des programmes du SIG CAMARGUE
Figure 7 : Exemple de fichier xls contenant les profils en travers à traiter.
Installation
1. Ouvrir VBA dans Excel
2. Copier le code dans un module
3. Nommer le module selon vos aspirations
4. Fermer VBA
5. Eventuellement rajouter un bouton dans Excel lié à la macro.
6. Dans le menu Outils, allez dans Personnalisation puis dans l’onglet Commandes et la
catégorie Macros. Cliquez dans Bouton personnalisé et le faire glisser vers une barre
d’outil. Ensuite par un clic droit sur le bouton faire Affecter une macro.
Utilisation
Ce programme s’exécute simplement en cliquant sur le bouton affecté à la macro ou en
utilisant la fonction Executer une macro dans le menu Outils.
Lors de l’exécution, vous devrez saisir au fur et à mesure la zone contenant les profils.
PRECAUTIONS D’EMPLOI
• Il faut modifier dans le code le chemin pour le fichier x y z en sortie.
Jules Fleury / CEREGE 31/05/2011 6

Documentation des programmes du SIG CAMARGUE
• Si le(s) fichier xls en entrée n’est pas au format présenté Figure 7, alors il faut
modifier le code pour prendre en compte le format. Une autre solution si vous
ne voulez pas rentrer dans le code et que vous avez peu de fichiers à traiter est
de mettre en forme manuellement chacun de vos fichiers.
• Il faut que le fichier contenant les coordonnées des extrémités du profil soit
ouvert, soit nommé XY PK.xls, et possède exactement la même structure que le
fichier présenté Figure 3.
Présentation
d. Calcul du profil en long à partir des profils en travers
Ce programme prend en entrée un fichier .xls contenant un ensemble de profils en travers au
format présenté Figure 5 et crée un fichier .xls, nommé pl_date_s.xls, contenant les
coordonnées et la côte du talweg. Le calcul s’effectue en prenant chaque point bas de profil en
travers.
Figure 8 : Exemple de fichier contenant le profil en long calculé à partir des profils en travers.
Installation
1. Ouvrir VBA dans Excel
2. Copier le code dans un module
3. Nommer le module selon vos aspirations
4. Fermer VBA
5. Eventuellement rajouter un bouton dans Excel lié à la macro.
6. Dans le menu Outils, allez dans Personnalisation puis dans l’onglet Commandes et la
catégorie Macros. Cliquez dans Bouton personnalisé et le faire glisser vers une barre
d’outil. Ensuite par un clic droit sur le bouton faire Affecter une macro.
Jules Fleury / CEREGE 31/05/2011 7

Documentation des programmes du SIG CAMARGUE
Utilisation
Ce programme s’exécute simplement en cliquant sur le bouton affecté à la macro ou en
utilisant la fonction Executer une macro dans le menu Outils.
PRECAUTIONS D’EMPLOI
• Il faut modifier dans le code le chemin pour le fichier en sortie.
• Si le(s) fichier xls en entrée n’est pas au format présenté Figure 5, alors il faut
modifier le code pour prendre en compte le format. Une autre solution si vous
ne voulez pas rentrer dans le code et que vous avez peu de fichiers à traiter est
de mettre en forme manuellement chacun de vos fichiers.
• Il faut que le fichier de synthèse nommé p_date_s.xls contenant les
coordonnées et les côtes de tous les profils en long soit ouvert.
e. Comparaison des profils en long
Présentation
Ce programme prend en entrée les fichiers de profils en long tel que présenté Figure 8 et
implémente un fichier de synthèse mettant en relation tous les profils en long.
Figure 9 : Fichier de comparaison des profils en long
Ce fichier permet de créer un graphe montrant l’évolution des profils.
Jules Fleury / CEREGE 31/05/2011 8

Documentation des programmes du SIG CAMARGUE
Figure 10 : Graphe de comparaison des profils en long
Installation
1. Ouvrir VBA dans Excel
2. Copier le code dans un module
3. Nommer le module selon vos aspirations
4. Fermer VBA
5. Eventuellement rajouter un bouton dans Excel lié à la macro.
6. Dans le menu Outils, allez dans Personnalisation puis dans l’onglet Commandes et la
catégorie Macros. Cliquez dans Bouton personnalisé et le faire glisser vers une barre
d’outil. Ensuite par un clic droit sur le bouton faire Affecter une macro.
Utilisation
Ce programme s’exécute simplement en cliquant sur le bouton affecté à la macro ou en
utilisant la fonction Executer une macro dans le menu Outils.
Au fur et à mesure vous devrez saisir la date du profil en long à rajouter.
PRECAUTIONS D’EMPLOI
• Avant chaque ajout d’un profil en long, allez dans le code et modifiez la cellule
destinée à contenir le nouveau profil.
• Il faut que tous les fichiers des profils en long à traiter soient ouverts. De même
que le fichier en sortie, nommé compare_profils.xls, et contenant une première
colonne pk (profil) avec la liste de tous les pk.
• Si le(s) fichier xls en entrée n’est pas au format présenté Figure 5, alors il faut
modifier le code pour prendre en compte le format. Une autre solution si vous
ne voulez pas rentrer dans le code et que vous avez peu de fichiers à traiter est
de mettre en forme manuellement chacun de vos fichiers.
Jules Fleury / CEREGE 31/05/2011 9

Documentation des programmes du SIG CAMARGUE
B. Liste des programmes
Titre Description Langage Type
Trait_txt_multiple Crée un fichier Excel de VBA Excel Macro Excel
points avec x y z à partir
de profils sous forme de
fichiers txt
Trait_f_xls
Crée un fichier Excel de VBA Excel Macro Excel
points avec x y z à partir
de profils sous forme de
fichiers xls
Calcul_profil_long Calcul le profil en long VBA Excel Macro Excel
d’un talweg à partir de
profils en travers
Compare_profil_long Met en relation des
profils en long pour
comparaison des altitudes
VBA Excel Macro Excel
Jules Fleury / CEREGE 31/05/2011 10

Traitement profil travers txt
C. Annexes : Code
a. Traitement profils travers txt
Le code est ici.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'programme de traitement de plusieurs fichiers txt de profil en 'travers
'output: un fichier excel par profil en travers + un fichier de 'synthèse
' en input les fichiers txt doivent avoir le même séparateur,
' la même structure et la même entête
' le fichier de synthèse doit être ouvert et le fichier XY PK aussi
'
'JULES FLEURY 10/10/02
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim date3 As String
'procédure d'ouverture des fichiers txt
Sub trait_xf_txt()
Dim QuelFichier()
Dim StrNomFichier As String
Dim StrNomFichier1 As String
date3 = InputBox("Entrez la date de levé des profils")
QuelFichier = Application.GetOpenFilename(, , , , True)
For Ctr = 1 To UBound(QuelFichier)
StrNomFichier = QuelFichier(Ctr)
'attention au séparateur dans le txt
' ici comma
Workbooks.OpenText Filename:=StrNomFichier, ConsecutiveDelimiter:=True,
Tab:=False, Comma:=True, Space:=False
'fin attention
StrNomFichier1 = ActiveWorkbook.Name
Call traittxt(StrNomFichier)
Windows(StrNomFichier1).Close
Next
End Sub
'procédure de traitement de chaque fichier txt
Sub traittxt(nomf As String)
Dim nom, nomfs, nomfs1 As String
Dim chemin As String
Dim date1 As String
Dim pk As String
Dim Zone, i As Range
Dim c, d, e As Object
Jules Fleury / CEREGE 31/05/2011 11

Traitement profil travers txt
'selection des données du profil
Set Zone = Range("A1")
Zone.CurrentRegion.Select
' MsgBox ("Vous avez sélectionné la zone " & Selection.Address)
Selection.Copy
'création d'un nouveau fichier avec ces données
Workbooks.Add
'copie des données et création de l'entête
'attention à vérifier dans le txt la structure de l'entete
' ici on commence à coller en B1
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'on extrait le nom du pk et on supprime la ligne d'entete
pk = Mid(Cells(1, 2), 5, 5)
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Rows("1:1").Select
'Selection.Delete Shift:=xlUp
'fin attention
'création de l'entête
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Value = "rg"
Range("A2").Value = "rd"
Range("A3:B3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
Jules Fleury / CEREGE 31/05/2011 12

.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A3").Value = "Zone geographique"
Range("A4:B4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A4").Value = "Chute"
Range("A5:B5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A5").Value = "Ouvrage"
Range("A6:B6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A6").Value = "Profil"
Range("C6").Value = pk
Traitement profil travers txt
Jules Fleury / CEREGE 31/05/2011 13

Range("A7:B7").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A7").Value = "Levé"
Range("C7").Value = date3
Cells(8, 1) = "N° PT"
Cells(8, 2) = "Distance"
Cells(8, 3) = "cote"
Cells(8, 4) = "x"
Cells(8, 5) = "y"
Cells(8, 6) = "pk"
date1 = date3
nom = "p_" & date3 & "_" & pk & ".xls"
nomfs = "p_" & date3 & "_s" & ".xls"
Traitement profil travers txt
chemin = "c:\Documents and
Settings\FLEURY\Bureau\sig_camargue\data\data_christelle\a traiter\f_excel\"
ActiveWorkbook.saveas Filename:=chemin & nom, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'affectation de la valeur du pk à la colonne pk"
Set Zone = Range("B9")
Set d = Cells(65536, Zone.Column).End(xlUp)
Set e = d.Offset(0, 4)
Set Zone = Range(Range("F9"), e.Address)
Zone.Value = pk
'selection des coordonnées du pk
Windows("XY PK.xls").Activate
Set Zone = Range("E2:E617").Find(pk)
Range(Zone.Offset(0, -4), Zone.Offset(0, -1)).Copy
'copie des coordonnées du pk
Windows(nom).Activate
Jules Fleury / CEREGE 31/05/2011 14

Range("B2").Select
ActiveSheet.Paste
Range("D2:E2").Select
Application.CutCopyMode = False
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
'Calcul des coordonnées de chaque point
Traitement profil travers txt
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=(R1C2-R2C2)/SQRT((POWER(R1C2-R2C2,2)+POWER(R1C3-R2C3,2)))"
Range("d2").Select
ActiveCell.FormulaR1C1 = _
"=(R1C3 - R2C3)/SQRT((POWER(R1C2-R2C2,2)+POWER(R1C3-R2C3,2)))"
'calcul de x
Range("d9").Select
ActiveCell.FormulaR1C1 = "=R2C2+RC[-2]*R1C4"
Range("d9").Select
ActiveCell.Copy
Set e = d.Offset(0, 2)
Set Zone = Range(Range("D9"), e.Address)
Zone.Select
ActiveSheet.Paste
'calcul de y
Range("E9").Select
ActiveCell.FormulaR1C1 = "=R2C3+RC[-3]*R2C4"
Range("e9").Select
ActiveCell.Copy
Set e = d.Offset(0, 3)
Set Zone = Range(Range("E9"), e.Address)
Zone.Select
ActiveSheet.Paste
ActiveWorkbook.Save
'creation du fichier de synthese
Windows(nom).Activate
Set e = d.Offset(0, 4)
Range(Range("A9"), e.Address).Copy
Windows(nomfs).Activate
Range("B1").Select
Set d = Cells(65536, ActiveCell.Column).End(xlUp)
Set e = d.Offset(1, -1)
Jules Fleury / CEREGE 31/05/2011 15

Traitement profil travers txt
e.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
Windows(nom).Close
End Sub
Jules Fleury / CEREGE 31/05/2011 16

Traitement profil travers xls
b. Traitement profils travers xls
Le code est ici.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' programme mettant en forme un fichier de profils en travers de type Excel
' enregistré le 02/10/2002 par jules fleury
' Touche de raccourci du clavier: Ctrl+q
'
' en output on a un fichier par profil en travers et un fichier de synthèse de
' tous les profils en travers
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub prof_xls()
Dim nom, nomfs, nomfs1 As String
Dim chemin As String
Dim date1 As String
Dim date2 As String
Dim pk As String
Dim Zone, i As Range
Dim c, d, e As Object
'selection des données du profil
'Set Zone = Application.InputBox("Sélectionnez le profil a traiter ! Y-compris l'entête",
Type:=8)
Set Zone = Application.InputBox("Sélectionnez la cellule Zone Geographique du profil a
traiter ! ", Type:=8)
Zone.CurrentRegion.Select
'MsgBox ("Vous avez sélectionné la zone " & Selection.Address)
'If (Zone Is Nothing) Then
' MsgBox "vous devez d'abord selectionner une zone"
' Exit Sub
'End If
Selection.Copy
'création d'un nouveau fichier avec ces données
Workbooks.Add
Range("A3").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "rg"
Range("A2").Select
Jules Fleury / CEREGE 31/05/2011 17

ActiveCell.FormulaR1C1 = "rd"
Cells(8, 4) = "x"
Cells(8, 5) = "y"
Cells(8, 6) = "pk"
Traitement profil travers xls
date1 = Cells(7, 3)
date2 = Mid(date1, 1, 2) & Mid(date1, 4, 2) & Mid(date1, 9, 2)
nom = "p_" & date2 & "_" & Cells(6, 3) & ".xls"
nomfs = "p_" & date2 & "_s" & ".xls"
chemin = "c:\Documents and
Settings\FLEURY\Bureau\sig_camargue\data\data_christelle\a traiter\f_excel\"
ActiveWorkbook.saveas Filename:=chemin & nom, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'affectation de la valeur du pk à la colonne pk"
Set Zone = Range("A9")
c = Zone
Set d = Cells(65536, Zone.Column).End(xlUp)
Set e = d.Offset(0, 5)
Set Zone = Range(Cells(9, 1), d.Address).Offset(0, 5)
Zone.Value = Cells(6, 3)
pk = Range("C6").Value
'pkval = Range("C6").Value
'selection des coordonnées du pk
Windows("XY PK.xls").Activate
'MsgBox "ouvrez le fichier XY PK.xls"
'dlgAnswer = Application.Dialogs(xlDialogOpen).Show
Set Zone = Range("E2:E617").Find(pk)
Range(Zone.Offset(0, -4), Zone.Offset(0, -1)).Copy
'Set Zone = Application.InputBox("Sélectionnez les coordonnées du pk " & pk, Type:=8)
' MsgBox ("Vous avez sélectionné la zone " & Zone.Address)
'Zone.Copy
'copie des coordonnées du pk
Windows(nom).Activate
Range("B2").Select
ActiveSheet.Paste
Range("D2:E2").Select
Application.CutCopyMode = False
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Jules Fleury / CEREGE 31/05/2011 18

Traitement profil travers xls
'Calcul des coordonnées de chaque point
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=(R1C2-R2C2)/SQRT((POWER(R1C2-R2C2,2)+POWER(R1C3-R2C3,2)))"
Range("d2").Select
ActiveCell.FormulaR1C1 = _
"=(R1C3 - R2C3)/SQRT((POWER(R1C2-R2C2,2)+POWER(R1C3-R2C3,2)))"
'calcul de x
Range("d9").Select
ActiveCell.FormulaR1C1 = "=R2C2+RC[-2]*R1C4"
Range("d9").Select
ActiveCell.Copy
Set Zone = Range(Cells(9, 1), d.Address).Offset(0, 3)
Zone.Select
ActiveSheet.Paste
'calcul de y
Range("E9").Select
ActiveCell.FormulaR1C1 = "=R2C3+RC[-3]*R2C4"
Range("e9").Select
ActiveCell.Copy
Set Zone = Range(Cells(9, 1), d.Address).Offset(0, 4)
Zone.Select
ActiveSheet.Paste
ActiveWorkbook.Save
'creation du fichier de synthese
Windows(nom).Activate
Range(Range("A9"), e.Address).Copy
Windows(nomfs).Activate
Range("A1").Select
Set d = Cells(65536, ActiveCell.Column).End(xlUp)
Set e = d.Offset(1, 0)
e.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
Windows(nom).Close
End Sub
Jules Fleury / CEREGE 31/05/2011 19

Calcul profil long
c. Calcul profils long
Le code est ici.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' procedure de calcul d'un profil en long
' input: un fichier de points x y z pk des profils en travers
' output: un fichier x y z pk du profil en long
' pour chaque pk, extrait le z minimum et le stocke dans
' un nouveau fichier
' Jules FLEURY 10 10 02
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub calcproflong()
Dim x, y, x1 As Object
Dim min As Double
Dim coordx As Double
Dim coordy As Double
Dim date1 As String
Dim nomf As String
Dim nomfpl As String
' attention: le fichier input doit être ouvert et
' s'appeler p_date_s.xls
date1 = InputBox("saisissez la date du profil")
nomf = "p_" & date1 & "_s.xls"
nomfpl = "pl_" & date1 & "_s.xls"
chemin = "c:\Documents and Settings\FLEURY\Bureau\sig_camargue\data\data_christelle\a
traiter\f_excel\"
Set x = Application.InputBox("Sélectionnez le 2eme pt du fichier, colonne pk! ", Type:=8)
Set y = x.Offset(0, -3)
'création du fichier de profil en long
Workbooks.Add
Set x1 = Range("A2")
Range("C1").Value = "cote"
Range("D1").Value = "x"
Range("E1").Value = "y"
Range("F1").Value = "pk"
ActiveWorkbook.saveas Filename:=chemin & nomfpl, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'recherche du z minimum
Windows(nomf).Activate
min = y.Offset(-1, 0).Value
coordx = y.Offset(-1, 1).Value
Jules Fleury / CEREGE 31/05/2011 20

Calcul profil long
coordy = y.Offset(-1, 2).Value
Do Until IsEmpty(x)
If x.Row > 1 Then
If x.Offset(-1, 0).Value = x.Value Then
If y.Value < min Then
min = y.Value
coordx = y.Offset(0, 1).Value
coordy = y.Offset(0, 2).Value
End If
End If
If x.Offset(-1, 0).Value x.Value Then
Rows(x.Row).Insert Shift:=xlDown
x.Offset(-1, 0).Value = x.Offset(-2, 0).Value
y.Offset(-1, 0).Value = min
y.Offset(-1, 1).Value = coordx
y.Offset(-1, 2).Value = coordy
Rows(x.Offset(-1, 0).Row).Cut
'copie du z minimum dans le fichier de profil en long
Windows(nomfpl).Activate
x1.Select
ActiveSheet.Paste
Set x1 = x1.Offset(1, 0)
' clean du fichier input
Windows(nomf).Activate
x.Offset(-1, 0).Select
Rows(Selection.Row).Delete Shift:=xlUp
' réinitialisation à 20 m du z minimum
min = 20
End If
End If
Set x = x.Offset(1, 0)
Set y = x.Offset(0, -3)
Loop
' traitement du dernier profil en travers
x.Value = x.Offset(-2, 0).Value
y.Value = min
y.Offset(0, 1).Value = coordx
y.Offset(0, 2).Value = coordy
Rows(x.Row).Cut
Windows(nomfpl).Activate
x1.Select
ActiveSheet.Paste
Jules Fleury / CEREGE 31/05/2011 21

'mise en forme du fichier de profil en long
Columns("A:B").Select
Selection.Delete Shift:=xlLeft
Workbooks(nomfpl).Save
End Sub
Calcul profil long
Jules Fleury / CEREGE 31/05/2011 22

d. Comparaison profils long
Le code est ici.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' procedure de création d'un fichier avec tous les profils en long
' pour toutes les dates
' output: le fichier doit déjà exister et s'appelle ici compare_profils
' pk cote date1 cote date2 ...
' pk1 z z ...
' pk2 z z ...
' en input il faut les fichiers de profil en long
' à chaque traitement d'un fichier de profil en long il faut
' incrémenter là ou c'est précisé dans le code
'
' jules fleury 10 10 02
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub comp_pl()
Dim nom1 As String
Dim nom2 As String
Dim x, y As Object
Dim date1 As String
Dim pk As String
Dim cote As Double
nom1 = "compare_profils.xls"
date1 = InputBox("saisissez la date du profil à rajouter")
nom2 = "pl_" & date1 & "_s.xls"
'attention, incrémenter la colonne au fur et à mesure
'de l'ajout des profils
Range("N1").Value = "cote " & date1
' fin attention
Windows(nom2).Activate
Set x = Range("D2")
Do Until IsEmpty(x)
pk = x.Value
cote = x.Offset(0, -3).Value
Windows(nom1).Activate
Set y = Range("A2")
Do Until IsEmpty(y)
If (y.Value = pk) Then
'attention de bien incrémenter l'offset
y.Offset(0, 13).Value = cote
'fin attention
Jules Fleury / CEREGE 31/05/2011 23

Windows(nom2).Activate
End If
Set y = y.Offset(1, 0)
Loop
Set x = x.Offset(1, 0)
Loop
End Sub
Jules Fleury / CEREGE 31/05/2011 24