1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
| Public Sub Bouton_ajout_meteo_Click()
On Error GoTo erreur
Doublons = 0
'teste si un chemin à été indiqué
If texte_chemin_fichier_import_meteo = "" Then MsgBox ("Vous devez indiquer un chemin de fichier")
Set appli = New Excel.Application
appli.Visible = False
chemin_fichier_import_meteo = Form_formulaire_ajouter_meteo.texte_chemin_fichier_import_meteo.Value
Set class = appli.Workbooks.Open(chemin_fichier_import_meteo)
Set feuil = class.ActiveSheet
feuil.Range("A7:A60000").Select
Selection.TextToColumns Destination:=feuil.Range("A7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1)), TrailingMinusNumbers:=True
Cells(7, 2).Select
'compte le nombre de ligne du fichier
nb_lignes = (feuil.Cells(Range("B:B").Count, ActiveCell.Column).End(xlUp).Row) - 6
dern_ligne = Range("B65536").End(xlUp).Row
'dimmensionne la barre de progression
Form_formulaire_ajouter_meteo.mabarre.Min = 0
Form_formulaire_ajouter_meteo.mabarre.Max = nb_lignes - 7
'met en forme la date
feuil.Cells(7, 1).Value = "date heure"
Cells(8, 1).Formula = "=(CONCATENATE(RC[3]&""/""&RC[2]&""/""&RC[1]&"" ""&RC[4]&"":00"")*1)"
Range("A8").Select
Selection.Copy
Range(Cells(8, 1), Cells(dern_ligne, 1)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.NumberFormat = "m/d/yyyy h:mm"
'recupere le nom de la station dans l'entete du fichier stefcli
nom_station = Mid(feuil.Cells(3, 1).Value, 12, 8)
'insere les enregistrements dans la table t_meteo_horaire
Set base = CurrentDb
Set rs = base.OpenRecordset("public_t_meteo_horaire")
For a = 8 To nb_lignes
rs.AddNew
rs("num_poste") = nom_station
rs("date_mesure") = Cells(a, 1).Value
rs("an") = Cells(a, 2).Value
rs("mois") = Cells(a, 3).Value
rs("jour") = Cells(a, 4).Value
rs("heure") = Cells(a, 5).Value
rs("di") = Cells(a, 6).Value
rs("h") = Cells(a, 7).Value
rs("i5") = Cells(a, 8).Value
rs("p") = Cells(a, 9).Value
rs("rg") = Cells(a, 10).Value
rs("rr") = Cells(a, 11).Value
rs("t") = Cells(a, 12).Value
rs("ts") = Cells(a, 13).Value
rs("u") = Cells(a, 14).Value
rs("u8") = Cells(a, 15).Value
rs("u9") = Cells(a, 16).Value
rs("us") = Cells(a, 17).Value
rs("vt") = Cells(a, 18).Value
rs("vx") = Cells(a, 19).Value
rs.Update
Form_formulaire_ajouter_meteo.mabarre.Value = a - 7
Next a
ActiveWorkbook.Close savechanges:=False
appli.Quit
Set appli = Nothing
'ferme le formulaire
Form_formulaire_ajouter_meteo.SetFocus
If Doublons > 0 Then
Form_formulaire_ajouter_meteo.texte_Doublons.Visible = True
Form_formulaire_ajouter_meteo.texte_Doublons.Value = Doublons
End If
Exit Sub
erreur:
Select Case Err
Case 3155
Beep
Doublons = Doublons + 1
Resume Next
End Select
End Sub |
Partager