iStarOSX
XLDnaute Junior
Bonsoir a tous les Exeliens.
Voila j'ai fais une application qui fonctionne enfin, mais voila j'ai une macro qui est lourde a l'exécution.
Normal je suis l'oing d'être un pro de VBA, je bidouille seulement !!!
Si quelq'un pouvait m'aider a ameliorer mon code, ce serait sympa.
Voici mon (Long) code :
Merci d'avance pour l'aide !!!
Bonne soirée
Voila j'ai fais une application qui fonctionne enfin, mais voila j'ai une macro qui est lourde a l'exécution.
Normal je suis l'oing d'être un pro de VBA, je bidouille seulement !!!
Si quelq'un pouvait m'aider a ameliorer mon code, ce serait sympa.
Voici mon (Long) code :
Code:
Sub Transfert_Radiateurs_Temp()
If Sheets("Catalogue").Range("A1") > 0 And Sheets("Catalogue").Range("I3") > 0 Then 'condition pour executer la macro
Application.ScreenUpdating = False
'Déprotège la feuille :
Sheets("Catalogue").Unprotect "chau"
Sheets("Radiateurs du Projet").Unprotect "chau"
'Déprotège le classeur :
ActiveWorkbook.Unprotect "chau"
' Désactive les filtres automatique
If Worksheets("Catalogue").AutoFilterMode Then
Worksheets("Catalogue").AutoFilterMode = False
End If
Sheets("Radiateurs du Projet").Range("D1") = 1
'Rend visible la feuille de transfert temporaire :
Sheets("Rad_Temp").Visible = True
'Efface les données de la plage de destination :
Sheets("Rad_Temp").Select
Cells.Select
Selection.Delete Shift:=xlUp
Dim L1%, I%, J% ' variable %= as integer
L1 = 26 ' num de ligne
Do ' boucle
Select Case Sheets("Catalogue").Range("b" & L1).Value ' selon valeur Qté
Case 0, "", " "
I = 0
Case 1
I = 1
Case Is > 1
I = Sheets("Catalogue").Range("b" & L1).Value
End Select
For J = 1 To I 'seconde boucle pour le transfert
'Transfert dans Rad_Temp les données radiateurs :
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(1, 0) = Sheets("Catalogue").Range("b" & L1).Value
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 1 To 11
.Offset(0, I) = Sheets("Catalogue").Cells(L1, 3 + I) ' "e" est la cinquième colonne
Next I
End With
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 12 To 25
.Offset(0, I) = Sheets("Catalogue").Cells(L1, 4 + I) ' "e" est la cinquième colonne
Next I
End With
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 28) = Sheets("Catalogue").Range("ad" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 29) = Sheets("Catalogue").Range("ae" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 30) = Sheets("Catalogue").Range("af" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 31) = Sheets("Catalogue").Range("ag" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 32) = Sheets("Catalogue").Range("ah" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 33) = Sheets("Catalogue").Range("ai" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 34) = Sheets("Catalogue").Range("aj" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 35) = Sheets("Catalogue").Range("ak" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 36) = Sheets("Catalogue").Range("al" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 37) = Sheets("Catalogue").Range("am" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 38) = Sheets("Catalogue").Range("an" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 39) = Sheets("Catalogue").Range("ao" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 40) = Sheets("Catalogue").Range("ap" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 42) = Sheets("Catalogue").Range("aq" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 43) = Sheets("Catalogue").Range("ar" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 44) = Sheets("Catalogue").Range("as" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 45) = Sheets("Catalogue").Range("at" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 46) = Sheets("Catalogue").Range("au" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 47) = Sheets("Catalogue").Range("av" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 48) = Sheets("Catalogue").Range("aW" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 49) = Sheets("Catalogue").Range("ax" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 50) = Sheets("Catalogue").Range("ay" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 51) = Sheets("Catalogue").Range("aZ" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 52) = Sheets("Catalogue").Range("BA" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 53) = Sheets("Catalogue").Range("BB" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 54) = Sheets("Catalogue").Range("BC" & L1).Value
'Insertion des formules
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 55) = "=IF(OR(AND(RC[-29]=RC[-13],AND(RC[-6]<>"""",RC[-6]<>0)),RC[-29]<>RC[-13]),""Valide"",""Non Valide"")"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 65) = "=IF(COUNTIF(Rad_Projet_NomLocal,RC[-76]) >0, RC[-77]& "" : ""&RC[-76])"
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 66 To 95
.Offset(0, I) = "=RC[-76]*1" ' "e" est la cinquième colonne
Next I
End With
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 77 To 79
.Offset(0, I) = "=RC[-76]" ' "e" est la cinquième colonne
Next I
End With
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 95) = "=RC[-76]"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 87) = "=RC[-76]/1000"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 96) = "=RC[-70]"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 97) = "=IF(OR(RC[-70]="""",RC[-70]=0),0,1)"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 98) = "=RC[-70]"
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 99 To 103
.Offset(0, I) = "=IF(RC[-70]=""-"",0,RC[-70])" ' "e" est la cinquième colonne
Next I
End With
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 104 To 105
.Offset(0, I) = "=RC[-62]" ' "e" est la cinquième colonne
Next I
End With
With Sheets("Rad_Temp").Range("m65536").End(xlUp)
For I = 106 To 110
.Offset(0, I) = "=IF(RC[-62]=""-"",0,RC[-62])" ' "e" est la cinquième colonne
Next I
End With
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 111) = "=IF(OR(RC[-62]="""",RC[-62]=0),0,1)"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 112) = "=RC[-61]*1"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 113) = Sheets("Catalogue").Range("BA" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 114) = Sheets("Catalogue").Range("C" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 116) = Sheets("Catalogue").Range("BB" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 117) = Sheets("Catalogue").Range("BC" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 118) = "=IF(OR(AND(OR(AND(RC[-22]=5,RC[-14]=7,RC[-9]=R6C131),AND(RC[-22]=5,RC[-14]=6,(RC[-17]-RC[-9])=R6C131)),RC[-7]=0),AND(OR(AND(RC[-22]=6,RC[-14]=6,(RC[-16]+RC[-9])=R6C131),AND(RC[-22]=5,RC[-14]=5,(RC[-17]+RC[-10])=R6C131)),RC[-7]>0)),1,0)"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 119) = Sheets("Catalogue").Range("BD" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 120) = Sheets("Catalogue").Range("BE" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 121) = "=IF(RC[-2]=""Robinetterie integrée du fabricant de radiateur"",RC[-4],""Rxl_""&SUBSTITUTE(RC[-2],"" "",""_"")&"".csv"")"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 122) = "=""Rxl_""&SUBSTITUTE(RC[-2],"" "",""_"")&"".csv"""
'Transfert dans Rad_Temp les données du local :
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, -12) = "1"
With Sheets("Rad_Temp").Range("a65536").End(xlUp)
For I = 1 To 5
.Offset(0, I) = Sheets("Catalogue").Cells(3, 4 + I) ' "e" est la cinquième colonne
Next I
End With
With Sheets("Rad_Temp").Range("a65536").End(xlUp)
For I = 1 To 5
.Offset(0, 5 + I) = Sheets("Catalogue").Cells(6, 5 + I) ' "e" est la cinquième colonne
Next I
End With
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, -1) = Sheets("Catalogue").Range("L6").Value
'hateur sous Rad
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 115) = Sheets("Catalogue").Range("M6").Value
Next
L1 = L1 + 1
Loop Until Sheets("Catalogue").Range("D" & L1).Value = "" ' sortie de la boucle do
'Valide numérotation radiateur
NumRad
Sheets("Rad_Temp").Activate
Sheets("Radiateurs du Projet").Outline.ShowLevels RowLevels:=2
Transfert_Radiateurs_Projet
'Efface les quantités dans le catalogue :
Sheets("Catalogue").Range("B26:B65536").ClearContents
'Fait passer a l'édition du local suivant :
Sheets("Catalogue").Range("A3") = Sheets("Catalogue").Range("B3").Value + 1
'Efface les données de la plage de destination :
Sheets("Rad_Temp").Select
Cells.Select
Selection.Delete Shift:=xlUp
'Rend Invisible la feuille de transfert temporaire :
Sheets("Rad_Temp").Visible = False
Sheets("Radiateurs du Projet").Range("D1") = 0
'Remet les filtres AUTO
Sheets("Catalogue").Range("A25:AZ25").AutoFilter
'Protège la feuille :
Sheets("Catalogue").Protect "chau", DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True
Sheets("Radiateurs du Projet").Protect "chau", DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlNoRestrictions
'Protège le classeur :
ActiveWorkbook.Protect "chau", Structure:=True, Windows:=False
Application.ScreenUpdating = True
End If
Sheets("Catalogue").Select
Range("B26").Select
End Sub
Code:
Sub NumRad()
Dim Cellule As Range
Dim Nomfeuille1 As String, Nomfeuille2 As String
Dim Col As String
Dim LigDep1 As Long, LigDep2 As Long
'parametre
Nomfeuille1 = "Catalogue"
Nomfeuille2 = "Rad_Temp"
'à modifier
LigDep1 = 26
LigDep2 = 2
Col = "b"
'
With Sheets(Nomfeuille1)
For Each Cellule In .Range(Col & LigDep2 & ":" & Col & Sheets(Nomfeuille2).Range(Col & .Rows.Count).End(xlUp).Row)
Sheets(Nomfeuille2).Range("a" & LigDep2) = "'" & .Range("B3") & "-" & Sheets(Nomfeuille2).Range("dw" & LigDep2) & "-" & .Range("D15") + LigDep2 - 1
LigDep2 = LigDep2 + 1
Next Cellule
End With
End Sub
Code:
Sub Transfert_Radiateurs_Projet()
If Sheets("Catalogue").Range("A1").Value = 1 Then
'Crée la liste de racc "Entrée"
Sheets("Rad_Temp").Select
Range("AM2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=AG2:AL2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'Crée la liste de racc "Sortie"
Sheets("Rad_Temp").Select
Range("BC2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=AV2:BB2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ValeurDefautRacc
'Transfert vers Radiateurs projet :
Sheets("Rad_Temp").Select
Range("2:2").Select
Selection.Copy
Sheets("Radiateurs du Projet").Select
Application.GoTo Reference:="R65536C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
End If
If Sheets("Catalogue").Range("A1").Value > 1 Then
'Crée les listes de racc "Entrée"
Sheets("Rad_Temp").Select
Range("AM2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=AG2:AL2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection.Copy
Range("M65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 26).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
'Crée les listes de racc "Sortie"
Sheets("Rad_Temp").Select
Range("BC2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=AV2:BB2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection.Copy
Range("M65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 42).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
ValeurDefautRacc
Application.GoTo Reference:="R65536C1"
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).EntireRow.Copy
Sheets("Radiateurs du Projet").Select
Application.GoTo Reference:="R65536C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Outline.ShowLevels RowLevels:=1
'Remet les filtres AUTO
Sheets("Radiateurs du Projet").Range("A6:BN6").AutoFilter
Sheets("Rad_Temp").Select
Rows("1:1").Select
Selection.EntireRow.Hidden = False
Sheets("Catalogue").Select
Range("B26").Select
End If
End Sub
Code:
Sub ValeurDefautRacc()
'Entre les valeurs de raccordements par défaut :
Sheets("Rad_Temp").Range("M65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 26).Range("A1").Activate
Range(Selection, Selection.End(xlUp)).Select
Selection.FormulaR1C1 = "=RC[8]"
Sheets("Rad_Temp").Range("M65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 42).Range("A1").Activate
Range(Selection, Selection.End(xlUp)).Select
Selection.FormulaR1C1 = "=RC[8]"
End Sub
Merci d'avance pour l'aide !!!
Bonne soirée