Option Explicit
Sub ImportCsv()
Dim Derlig As Long
Dim Col As Byte
Dim NbrLigMaxCsv As Integer
Dim Dossier As String, Fichier As String
Dossier = ThisWorkbook.Path
NbrLigMaxCsv = 300
Derlig = 1
Col = 1
Fichier = Dir(ThisWorkbook.Path & "\*.csv")
With ActiveSheet
.Cells.ClearContents
Do While Fichier <> ""
With .QueryTables.Add(Connection:="TEXT;" & Dossier & "\" & Fichier, Destination:=.Cells(Derlig, Col))
.TextFileStartRow = IIf(Derlig = 1, 1, 2)
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = True
.TextFileOtherDelimiter = """"
.TextFileColumnDataTypes = Array(9, 9, 4, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1)
.Refresh
.Delete
End With
Derlig = .Range("A65536").End(xlUp).Row + 1
If Derlig + NbrLigMaxCsv > 65536 Then
Call SeparateurDecimal(Derlig, Col)
Call AjoutCalculs(Derlig, .Range("IV1").End(xlToLeft).Column + 1)
Derlig = 1
Col = .Range("IV1").End(xlToLeft).Column + 2
End If
Fichier = Dir
Loop
If Derlig <> 1 Then
Call SeparateurDecimal(Derlig, Col)
Call AjoutCalculs(Derlig, .Range("IV1").End(xlToLeft).Column + 1)
End If
.UsedRange.Columns.AutoFit
End With
End Sub
Sub SeparateurDecimal(Derlig As Long, ColDeb As Byte)
With ActiveSheet
With .Range(.Cells(2, ColDeb), .Cells(Derlig, .Range("IV1").End(xlToLeft).Column))
Application.DisplayAlerts = False
If Application.DecimalSeparator = "." Then
.Replace what:=",", replacement:=".", lookat:=xlPart
Else
.Replace what:=".", replacement:=",", lookat:=xlPart
End If
Application.DisplayAlerts = True
End With
End With
End Sub
Sub AjoutCalculs(Derlig As Long, ColDeb As Byte)
With ActiveSheet
.Cells(1, ColDeb).Value = "Concentration" & vbLf & "de vapeur dans l'air"
.Cells(1, ColDeb + 1).Value = "Pression de" & vbLf & "saturation"
.Cells(1, ColDeb + 2).Value = "Pression de" & vbLf & "vapeur d 'eau"
.Cells(1, ColDeb + 3).Value = "Entalpie ext"
.Cells(2, ColDeb).FormulaR1C1 = "=(0.62*RC[2])/(96506-RC[2])"
.Cells(2, ColDeb + 1).FormulaR1C1 = "=610.78*EXP((RC[-3]/(RC[-3]+238.3))*17.2694)"
.Cells(2, ColDeb + 2).FormulaR1C1 = "=RC[-3]*(RC[-1]/100)"
.Cells(2, ColDeb + 3).FormulaR1C1 = "=((1.007*RC[-5]-0.026)+(RC[-3]*(2501+1.84*RC[-5])))"
With .Range(.Cells(2, ColDeb), .Cells(Derlig, ColDeb + 3))
.FillDown
Application.Calculate
'***************************************************************************
' Partie a commenter si tu veux conserver les formules dans les cellules
.Copy
.PasteSpecial Paste:=xlPasteValues
'***************************************************************************
End With
End With
End Sub
