Appliquer une maccro à toutes les feuilles (erreur 400)

morinn

XLDnaute Nouveau
Bonjour,
j'aide la personne qui organise le planning de mon boulot à faire un fichier pour cela.
J'ai fait une macro pour faire un calcul des horaires.
Le hic c'est que quand le code tourne j'obtiens une erreur 400 depuis que j'ai voulu appliquer un bout de code pour appliquer la macro à toutes les feuilles.
Alors voilà j'aimerai pouvoir :
- Appliquer mon code à toutes les feuilles (
Code:
For a = 1 To Sheets.Count

ActiveSheet.Select
- Savoir comment on peut faire pour que je puisse sélectionner une feuille en sachant qu'elle s'appelle sem1, sem2....sem52. Est ce possible de faire quelque chose pour que l'on puisse avoir par exemple :
Code:
For i = 1 to 52
Sheet(sem et là le i ).select
et donc remplacer mon et là le i par quelque chose qui renverrait vers sem1 ou 2.


Voici tout mon code
Code:
Sub Macro1()

For a = 1 To Sheets.Count

ActiveSheet.Select

a = 2
b = 2


Calcul:
Range(Cells(a, b), Cells(a, b + 18)).Select
If Cells(a, b) = "D" And Cells(a, b + 9) = "" Then D = D - 1
If Cells(a, b + 18) = "D" And Cells(a, b) = "" Then D = D - 1
If Cells(a, b) = "D" And Cells(a, b + 9) = "D" Then D = D - 0.5

If Cells(a, b) = "C" And Cells(a, b + 9) = "" Then C = C - 1
If Cells(a, b + 18) = "C" And Cells(a, b) = "" Then C = C - 1
If Cells(a, b) = "C" And Cells(a, b + 9) = "C" Then C = C - 0.5

If Cells(a, b) = "L" And Cells(a, b + 9) = "" Then L = L - 1
If Cells(a, b + 18) = "L" And Cells(a, b) = "" Then L = L - 1
If Cells(a, b) = "L" And Cells(a, b + 9) = "L" Then L = L - 0.5

If Cells(a, b) = "E" And Cells(a, b + 9) = "" Then E = E - 1
If Cells(a, b + 18) = "E" And Cells(a, b) = "" Then E = E - 1
If Cells(a, b) = "E" And Cells(a, b + 9) = "D" Then E = E - 0.5

If Cells(a, b) = "K" And Cells(a, b + 9) = "" Then K = K - 1
If Cells(a, b + 18) = "K" And Cells(a, b) = "" Then K = K - 1
If Cells(a, b) = "K" And Cells(a, b + 9) = "K" Then K = K - 0.5

If Cells(a, b) = "P" And Cells(a, b + 9) = "" Then P = P - 1
If Cells(a, b + 18) = "P" And Cells(a, b) = "" Then P = P - 1
If Cells(a, b) = "P" And Cells(a, b + 9) = "P" Then P = P + 0.5

If Cells(a, b) = "M" And Cells(a, b + 9) = "" Then M = M - 1
If Cells(a, b + 18) = "M" And Cells(a, b) = "" Then M = M - 1
If Cells(a, b) = "M" And Cells(a, b + 9) = "M" Then M = M + 0.5

If Cells(a, b) = "S" And Cells(a, b + 9) = "" Then S = S - 1
If Cells(a, b + 18) = "S" And Cells(a, b) = "" Then S = S - 1
If Cells(a, b) = "S" And Cells(a, b + 9) = "S" Then S = S + 0.5

If Cells(a, b) = "J" And Cells(a, b + 9) = "" Then J = J - 1
If Cells(a, b + 18) = "J" And Cells(a, b) = "" Then J = J - 1
If Cells(a, b) = "J" And Cells(a, b + 9) = "J" Then J = J + 0.5

If Cells(a, b) = "G" And Cells(a, b + 9) = "" Then G = G - 1
If Cells(a, b + 18) = "G" And Cells(a, b) = "" Then G = G - 1
If Cells(a, b) = "G" And Cells(a, b + 9) = "G" Then G = G + 0.5

For Each Cell In Selection
If Cell.Value = "D" Then D = D + 1
If Cell.Value = "C" Then C = C + 1
If Cell.Value = "L" Then L = L + 1
If Cell.Value = "E" Then E = E + 1
If Cell.Value = "K" Then K = K + 1
If Cell.Value = "P" Then P = P + 1
If Cell.Value = "M" Then M = M + 1
If Cell.Value = "S" Then S = S + 1
If Cell.Value = "J" Then J = J + 1
If Cell.Value = "G" Then G = G + 1
Next
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "D" Then D = D + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "C" Then C = C + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "L" Then L = L + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "E" Then E = E + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "K" Then K = K + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "P" Then P = P + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "M" Then M = M + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "S" Then S = S + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "J" Then J = J + 0.25
If Cells(a, b + 9) = "" And Cells(a, b + 10) = "G" Then G = G + 0.25
Cells(a, b + 19) = D
Cells(a, b + 20) = C
Cells(a, b + 21) = L
Cells(a, b + 22) = E
Cells(a, b + 23) = K
Cells(a, b + 24) = P
Cells(a, b + 25) = M
Cells(a, b + 26) = S
Cells(a, b + 27) = J
Cells(a, b + 28) = G

D = 0
C = 0
L = 0
E = 0
K = 0
P = 0
M = 0
S = 0
J = 0
G = 0

a = a + 1
If a = 41 Then GoTo Total
GoTo Calcul

GoTo Total


Total:
Range("U45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("V45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("W45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("X45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("Y45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("Z45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("AA45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("AB45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("AC45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"
Range("AD45").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-5]C)"


Next a


End Sub

Merci d'avance si vous pouvez m'aider à voir comment résoudre mon problème et comment.


P.S : Le code marchait parfaitement avant de le mettre dans This.Workbook et de tenter de l'appliquer à toutes les feuilles.
 

klin89

XLDnaute Accro
Re : Appliquer une maccro à toutes les feuilles (erreur 400)

Bonjour morinn,

Trouvé sur le forum, auteur skoobi

A placer dans le "ThisWorkbook"

VB:
Private Sub Workbook_Open()
sem = "Sem" & n_semaine(Date)
ThisWorkbook.Sheets(sem).Activate
End Sub

Function n_semaine(ladate)
resultat1 = (ladate - 2) Mod 7
annee = Year(ladate - resultat1 + 3)
jour1 = DateSerial(annee, 1, 1)
resultat2 = (jour1 + 1) Mod 7
n_semaine = Int((ladate - jour1 + resultat2 + 4) / 7)
End Function

Donc, aujourd'hui lundi 10 octobre 2011, tu cherches à te placer sur la feuille "Sem41" à l'ouverture de ton fichier.
Si j'ai bien compris ta demande :p

Klin89
 

morinn

XLDnaute Nouveau
Re : Appliquer une maccro à toutes les feuilles (erreur 400)

Tout d'abord merci.
J'avais fait une recherche mais je n'ai du utiliser les bons mots clés.

Ensuite, je ne comprenais pas pourquoi tu disais que je voulais aller sur la semaine 41 mais en fait ok j'ai compris mais non ce n'est pas ça.

Non ce que je veux c'est que la personne qui va utiliser le fichier puisse appliquer la macro à toutes les feuilles.

Du coup avec ta remarque je me suis aperçu que cela ne servirait à rien et donc je vais m'adapter autrement.
Je vais faire en sorte qu'en activant la macro elle puisse appliquer cette macro seulement à la feuille active. Je récupère le nom de la feuille active et la maccro s'applique.

Merci en tout cas, sans doute sans le vouloir tu m'as fait avancer un peu :)
 
Dernière édition:

klin89

XLDnaute Accro
Re : Appliquer une maccro à toutes les feuilles (erreur 400)

Re morinn,

Tu boucles sur tes feuilles comme ceci :

Code:
Sub Boucler()
  Dim Sh As Worksheet
  For Each Sh In Sheets
    If Left(Sh.Name, 3) = "Sem" Then
      .../...
    End If
  Next
End Sub
Klin89
 

Discussions similaires

Réponses
1
Affichages
194
Réponses
0
Affichages
175

Statistiques des forums

Discussions
312 438
Messages
2 088 406
Membres
103 842
dernier inscrit
ho9999