amelioration de code

[teamtat]

Bonjour,
je voudrais savoir si c'ete possible d'ameliorer mon code car la ce n'est que une petite partie, j'ai 300 ligne comme sa.
Je pense que ce soit possible avec une boucle for (je vois comment faire en C mais pas en VBA ) . Si quelqu'un a une idée
Merci

Sub export()

Dim Chemin As String, Fichier As String
Dim wk As Workbook
Dim feuil1 As Variant, shtpda As Variant

'*******Variable à définir**************
Chemin = "\\Angfs1\data\TKAF\R01\A427\_Commun-Agence\GENERAL\Dossier Camille\pda\"
Fichier = "pda.xls"
'***************************************
Application.ScreenUpdating = False


Set wk = Workbooks.Open(Chemin & Fichier)
Set shtbase = ThisWorkbook.Worksheets("base travaux")
Set shtpda = wk.Worksheets("pda")

shtbase.Range("C11,D11,E11,F11,G11,H11,N11,S11").Copy
shtpda.Range("A1").PasteSpecial


If shtbase.CheckBox8.Value = True Then
shtbase.Range("C12,D12,E12,F12,G12,H12,N12,S12").Copy
shtpda.Range("A2").PasteSpecial
End If

If shtbase.CheckBox9.Value = True Then
shtbase.Range("C13,D13,E13,F13,G13,H13,N13,S13").Copy
shtpda.Range("A3").PasteSpecial
End If

If shtbase.CheckBox10.Value = True Then
shtbase.Range("C14,D14,E14,F14,G14,H14,N14,S14").Copy
shtpda.Range("A4").PasteSpecial
End If

If shtbase.CheckBox11.Value = True Then
shtbase.Range("C15,D15,E15,F15,G15,H15,N15,S15").Copy
shtpda.Range("A5").PasteSpecial
End If


If shtbase.CheckBox12.Value = True Then
shtbase.Range("C16,D16,E16,F16,G16,H16,N16,S16").Copy
shtpda.Range("A6").PasteSpecial
End If

end sub

 

[natha]

Re : amelioration de code

quelque chose comme ca?

for x=2 to 300
If shtbase.CheckBox8.Value = True Then
shtbase.Range("C"&x+10,"D"&x+10,"E"&x+10,"F"&x+10,"G"&x+10,"H"&x+10,"I"&x+10,"J"&x+10").Copy
shtpda.Range("A"&x).PasteSpecial
End If
next


Pour le checkbox je vois pas comment tu peux faire

 

[martin2440]

Re : amelioration de code

Sub export()

Dim Chemin As String, Fichier As String
Dim wk As Workbook
Dim feuil1 As Variant, shtpda As Variant
Dim i

'*******Variable à définir**************
Chemin = "\\Angfs1\data\TKAF\R01\A427\_Commun-Agence\GENERAL\Dossier Camille\pda\"
Fichier = "pda.xls"
'***************************************
Application.ScreenUpdating = False

Set wk = Workbooks.Open(Chemin & Fichier)
Set shtbase = ThisWorkbook.Worksheets("base travaux")
Set shtpda = wk.Worksheets("pda")

shtbase.Range("C11,D11,E11,F11,G11,H11,N11,S11").Copy
shtpda.Range("A1").PasteSpecial

For i = 12 To 16
If shtbase.Controls("CheckBox" & i - 4).Value = True Then
Sheets("Feuil1").Range("C" & i & ":" & "H" & i & ",N" & i & ",S" & i).Copy
Sheets("Feuil1").Range("A" & i - 10).PasteSpecial
Next i

End Sub


Essaie çà.

 

[teamtat]

Re : amelioration de code

Merci pour vos réponse
martin 2440 il me met une erreur au next et i me di pas de next sans for
pourtant le for est au dessus, je ne comprend pas

 

[martin2440]

Re : amelioration de code

Autant pour moi, il faut rajouter "End if" juste avant "Next i"

 

[tototiti2008]

Re : amelioration de code

Bonjour à tous,

un essai :

remplace

If shtbase.CheckBox8.Value = True Then
shtbase.Range("C12,D12,E12,F12,G12,H12,N12,S12").Copy
shtpda.Range("A2").PasteSpecial
End If

If shtbase.CheckBox9.Value = True Then
shtbase.Range("C13,D13,E13,F13,G13,H13,N13,S13").Copy
shtpda.Range("A3").PasteSpecial
End If

If shtbase.CheckBox10.Value = True Then
shtbase.Range("C14,D14,E14,F14,G14,H14,N14,S14").Copy
shtpda.Range("A4").PasteSpecial
End If

If shtbase.CheckBox11.Value = True Then
shtbase.Range("C15,D15,E15,F15,G15,H15,N15,S15").Copy
shtpda.Range("A5").PasteSpecial
End If


If shtbase.CheckBox12.Value = True Then
shtbase.Range("C16,D16,E16,F16,G16,H16,N16,S16").Copy
shtpda.Range("A6").PasteSpecial
End If

par

For i = 8 to 12
if shtbase.OLEobjects("CheckBox" & i).object.value then shtbase.Range("C" & i+4 & ":H" & i+4 & ",N" & i+4 & ",S" & i+4).Copy shtpda.Range("A" & i-6)
next i

 

[teamtat]

Re : amelioration de code

pour le code de martin 2440
Cela fonctionne presque, j'ai une erreur sur cette ligne

If shtbase.Controls("CheckBox" & i - 4).Value = True Then

erreur d'execution '438' propriété ou méthode non géré par cette objet

 

[teamtat]

Re : amelioration de code

Merci tototiti2008 cela fonctionne parfaitement et c'est bocoup moin fastidieu a écrire