Sub RecupBen()
Dim i As Integer
Dim j As Integer
Dim y As Integer
Dim x As Integer
Dim t As Integer
Dim r As Integer
Dim u As Integer
Dim c As String
Dim D As String
Dim E As String
Dim z As String
Dim b As String
Dim b1 As Integer
Dim b2 As Integer
Dim XXX As Integer
Dim compteur1 As Integer
Dim compteur2 As Integer
Dim compteur3 As Integer
XXX = 0
u = 0
x = 15
z = ""
y = 4
c = ActiveWorkbook.Name
Ret = MsgBox("Vous devez selectionner un fichier EXPORT Climawin pour importer les données (Fichier EXPORT complet ou Fichier EXPORT Deperditions)," & vbCrLf & " Souhaitez vous continuer ?" & vbCrLf & " (L'importation des données peut prendre quelques secondes)", vbYesNo)
Select Case Ret
Case vbYes
fichier = Application.GetOpenFilename("Excel Files (*.csv), *.csv")
Workbooks.Open Filename:=fichier, Local:=True
i = Range("F4").End(xlDown).Offset(1, 0).Row
If Range("F" & i + 1) = "Surface (m²)" Then
While z <> "Surface (m²)"
i = Range("F" & y).End(xlDown).Offset(1, 0).Row
y = i + 1
z = Range("F" & y).Value
Wend
Else
i = Range("A4").End(xlDown).Offset(1, 0).Row
End If
' Verification ligne fichier export
For x = 4 To i
If Range("U" & x) <> "" Then
XXX = 1
t = Range("U" & x).End(xlToRight).Column
r = Range("U" & x).End(xlToLeft).Column
Range(Cells(x, r), Cells(x, t)).Select
Selection.Cut
Range("F" & x).Select
ActiveSheet.Paste
Else
End If
Next x
D = ActiveWorkbook.Name
E = Replace(D, ".csv", "")
j = i + 10
'Nom local
Workbooks(c).Sheets("Bâtiment").Range("C15:C" & j) = Workbooks(D).Sheets(E).Range("E4:E" & i).Value
'Surface
Workbooks(c).Sheets("Bâtiment").Range("D15:D" & j) = Workbooks(D).Sheets(E).Range("F4:F" & i).Value
'Volume
Workbooks(c).Sheets("Bâtiment").Range("F15:F" & j) = Workbooks(D).Sheets(E).Range("G4:G" & i).Value
'Tint
Workbooks(c).Sheets("Bâtiment").Range("J15:J" & j) = Workbooks(D).Sheets(E).Range("H4:H" & i).Value
'Transmission
Workbooks(c).Sheets("Bâtiment").Range("K15:K" & j) = Workbooks(D).Sheets(E).Range("J4:J" & i).Value
'infiltration
Workbooks(c).Sheets("Bâtiment").Range("L15:L" & j) = Workbooks(D).Sheets(E).Range("K4:K" & i).Value
'Surpuissance
Workbooks(c).Sheets("Bâtiment").Range("O15:O" & j) = Workbooks(D).Sheets(E).Range("P4:P" & i).Value
'Deperditions par ventilation
Workbooks(c).Sheets("Bâtiment").Range("M15:M" & j) = Workbooks(D).Sheets(E).Range("L4:L" & i).Value
'batiment
Workbooks(c).Sheets("Bâtiment").Range("A15:A" & j) = Workbooks(D).Sheets(E).Range("A4:A" & i).Value
'code piece
Workbooks(c).Sheets("Bâtiment").Range("B15:B" & j) = Workbooks(D).Sheets(E).Range("D4:D" & i).Value
'Puissance totale
For x = 15 To j
Workbooks(c).Sheets("Bâtiment").Range("Q" & x).Formula = "=if(RC[-3]="""",Sum(RC[-4]:RC[-1]),Sum(RC[-3]:RC[-1]))"
Next x
'Puissance à couvrir
For x = 15 To j
Workbooks(c).Sheets("Bâtiment").Range("S" & x).Formula = "=RC[-2]"
Next x
'Puissance par radiateur
For x = 15 To j
Workbooks(c).Sheets("Bâtiment").Range("T" & x).Formula = "=RC[-1]/RC[-2]"
Next x
'Hauteur
For x = 15 To j
Workbooks(c).Sheets("Bâtiment").Range("E" & x).Formula = "=RC[+1]/RC[-1]"
Next x
'Puissance dans le local
For x = 15 To j
Workbooks(c).Sheets("Bâtiment").Range("AA" & x).Formula = "=RC[-9]*RC[-1]"
Next x
'Deper statique
For x = 15 To j
Workbooks(c).Sheets("Bâtiment").Range("P" & x).Formula = "=RC[-4]+RC[-5]"
Next x
'Secu radiateur
Workbooks(c).Sheets("Bâtiment").Range("AC15:AC" & j) = 1
Workbooks(c).Sheets("Bâtiment").Range("R15:R" & j) = 1
Workbooks(c).Activate
Workbooks(D).Saved = True
Workbooks(D).Close
'Edition pieces sans chauffage
For x = j To 15 Step -1
If Range("K" & x) = " - " Then
Range("K" & x).Value = 0
Range("L" & x).Value = 0
Range("M" & x).Value = 0
Range("O" & x).Value = 0
Range("J" & x).Value = ""
Range("T" & x).Value = 0
Else
End If
Next x
'Verif Température vide
For x = j To 15 Step -1
If Range("J" & x) = "-" Then
MsgBox ("Attention la temperature interieur n'est pas definie dans une ou plusieurs pieces. Merci de completer la ou les lignes correspondantes avant de poursuivre le calcul")
Exit For
Else
End If
Next x
'secu radiateur 2
Range("AC15").Value = 1
Ret = MsgBox("Voulez vous effectuer le calcul des totaux par batiment et par zone ?", vbYesNo)
Select Case Ret
Case vbYes
'Total par batiment
i = Range("A15").End(xlDown).Offset(1, 0).Row
b = Range("A15").Value
b1 = 0
For x = 15 To i + 100
If Range("A" & x) <> b Then
Rows(x & ":" & x).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(x & ":" & x).RowHeight = 49.5
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("A" & x) = "Somme " & b & " :"
b = Range("A" & x + 1).Value
x = x + 1
i = i + 1
b1 = 0
Else
b1 = b1 + 1
End If
Next x
Rows(i & ":" & i).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("A" & i) = "TOTAL :"
'Total par code piece
b1 = 0
b = Range("B15").Value
For x = 15 To i + 1000
If b = "" Then
x = x + 1
b = Range("B" & x + 1).Value
b1 = b1 + 1
Else
If Range("B" & x) <> b Then
Rows(x & ":" & x).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(x & ":" & x).RowHeight = 49.5
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
Rows(x & ":" & x).Select
'Range("B" & x).Select
With Selection
.VerticalAlignment = xlCenter
End With
Range("B" & x) = "Somme " & b & " :"
b = Range("B" & x + 2).Value
Range("D" & x).Formula = "=SUM(D" & x - 1 & ":D" & x - 1 - b1 & ")"
Range("F" & x).Formula = "=SUM(F" & x - 1 & ":F" & x - 1 - b1 & ")"
Range("K" & x).Formula = "=SUM(K" & x - 1 & ":K" & x - 1 - b1 & ")"
Range("L" & x).Formula = "=SUM(L" & x - 1 & ":L" & x - 1 - b1 & ")"
Range("M" & x).Formula = "=SUM(M" & x - 1 & ":M" & x - 1 - b1 & ")"
Range("O" & x).Formula = "=SUM(O" & x - 1 & ":O" & x - 1 - b1 & ")"
Range("Q" & x).Formula = "=SUM(Q" & x - 1 & ":Q" & x - 1 - b1 & ")"
Range("R" & x).Formula = "=SUM(R" & x - 1 & ":R" & x - 1 - b1 & ")"
Range("P" & x).Formula = "=SUM(P" & x - 1 & ":P" & x - 1 - b1 & ")"
Range("AA" & x).Formula = "=SUM(AA" & x - 1 & ":AA" & x - 1 - b1 & ")"
x = x + 2
i = i + 2
b1 = 0
Else
b1 = b1 + 1
End If
End If
Next x
'Calcul des totaux batiment
b1 = 15
For x = b1 To i
If Range("E" & x).Value = "" And Range("E" & x + 1).Value = "" And Range("E" & x + 2).Value = "" Then
If Range("A" & x) = "TOTAL :" Then
Exit For
Else
x = x + 2
Range("D" & x).Formula = "=SUM(D" & b1 & ":D" & x - 1 & ")/2"
Range("F" & x).Formula = "=SUM(F" & b1 & ":F" & x - 1 & ")/2"
Range("K" & x).Formula = "=SUM(K" & b1 & ":K" & x - 1 & ")/2"
Range("L" & x).Formula = "=SUM(L" & b1 & ":L" & x - 1 & ")/2"
Range("M" & x).Formula = "=SUM(M" & b1 & ":M" & x - 1 & ")/2"
Range("O" & x).Formula = "=SUM(O" & b1 & ":O" & x - 1 & ")/2"
Range("P" & x).Formula = "=SUM(P" & b1 & ":P" & x - 1 & ")/2"
Range("Q" & x).Formula = "=SUM(Q" & b1 & ":Q" & x - 1 & ")/2"
Range("R" & x).Formula = "=SUM(R" & b1 & ":R" & x - 1 & ")/2"
Range("AA" & x).Formula = "=SUM(AA" & b1 & ":AA" & x - 1 & ")/2"
b1 = x + 1
End If
Else
End If
Next x
'Calcul du total total
Range("D" & x).Formula = "=SUM(D15:D" & x - 1 & ")/3"
Range("F" & x).Formula = "=SUM(F15:F" & x - 1 & ")/3"
Range("K" & x).Formula = "=SUM(K15:K" & x - 1 & ")/3"
Range("L" & x).Formula = "=SUM(L15:L" & x - 1 & ")/3"
Range("M" & x).Formula = "=SUM(M15:M" & x - 1 & ")/3"
Range("O" & x).Formula = "=SUM(O15:O" & x - 1 & ")/3"
Range("P" & x).Formula = "=SUM(P15:P" & x - 1 & ")/3"
Range("Q" & x).Formula = "=SUM(Q15:Q" & x - 1 & ")/3"
Range("R" & x).Formula = "=SUM(R15:R" & x - 1 & ")/3"
Range("AA" & x).Formula = "=SUM(AA15:AA" & x - 1 & ")/3"
Case vbNo
End Select
'Erreur dans fichier Export
If XXX = 1 Then
MsgBox ("ATTENTION, le programme a détecte une anomalie dans le fichier EXPORT." & vbCrLf & " Erreur : donnees decalees pour une ligne." & vbCrLf & " L'anomalie a ete corrige lors de l'importation des donnees.")
Else
End If
'message de fin
MsgBox ("Importation terminée ! Vérifiez le nombre de radiateurs et l'orientation de ces derniers avant de lancer la selection automatique")
Case vbNo
End Select
End Sub