Microsoft 365 Appliquer un script à tous les classeur ouvert

Kapioss

XLDnaute Nouveau
Bonjour
Je cherche à appliquer mon script ci-dessous à tous les classeurs ouvert. En effet aujourd'hui je fais appelle à mon classeur avec with sheet("XXX") mais j'aimerais que ma macro lorsque je fais F5 s'applique à TOUS les classeur ouvert dans excel et je n'ai pas trouvé la solution sur le net.
J'aimerais faire cela afin de ne pas avoir a changer le nom du fichier a chaque fois dans le code.

merci et bonne journée

VB:
Sub precision_interne234U()

Dim j As Integer
Dim i As Integer
Dim moy As Double
Dim SD As Double
Dim moytest As Double
Dim SDtest As Double


With Sheets("017-IRMM100")

'on nomme les cellules de debut ou l'on mettra les différents résultat

    .Cells(57, 2) = "moyenne"
    .Cells(58, 2) = "StandDev(x2)"
    .Cells(59, 2) = "SD%"
    
'boucle for qui permettra de parcourir les colonne et donc de faire les isotopes 234U à 238U qui sont des colonnes 3 à 6, on parcours donc les colonnes 3 à 6

    For j = 3 To 9
        
    
        moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
        moytest = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SDtest = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) + 1
        
        'paramètre de test arbitraire on fera des test pour voir ce qui est le plus adequat 50%, 75% 80% etc
        Do Until SDtest - SD = 0
        
        'on parcours les lignes 24 à 53 où les 30 mesures d'un isotope sont avec la boucle for
            For i = 24 To 53

                If .Cells(i, j) >= 2 * SD + moy Then .Cells(i, j) = Empty
                If .Cells(i, j) <= 2 * SD - moy Then .Cells(i, j) = Empty
            
            Next
            
            'on stocke l'ancienne moyenne et l'ancien SD dans les variables XXXtest pour faire ensuite le test du while
            moytest = moy
            SDtest = SD
            moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
            SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
            
        Loop
        
        'on calcule les moy et SD finaux et on les affiche dans tel ou tel colonnes/lignes correspondante
        moyfinal = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SDfinal = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) * 2
        .Cells(57, j).Value = moyfinal
        .Cells(58, j).Value = SDfinal
        .Cells(59, j).Value = (SDfinal / moyfinal) * 100
      
        
    Next


End With
End Sub
 

Hasco

XLDnaute Barbatruc
Bonjour,

En effet aujourd'hui je fais appelle à mon classeur avec with sheet("XXX")
C'est faux, vous faites appelle à UNE feuille de du classeur actif (qui n'est pas forcément le classeur qui contient la macro ! )

Pour balayer tous les classeurs ouverts et à suposser que chacun d'eux ait une feuille nommée "017-IRMM100"
if vous faut une variable Classeur (Workbook) et une boucle For :



VB:
Dim wk As Workbook

' Parcourir les classeur
For each wk in Workbooks
 ' travail sur la feuille du classeur en cours
 With wk.Sheets("017-IRMM100")


 End With
' Eventuellement sauvegarder le changement
  wk.save
Next wk

Cordialement
 

Kapioss

XLDnaute Nouveau
Bonjour,

Premièrement merci de votre réponse. Je fais effectivement appelle à la feuille "017-IRMM100" et pas au classeur.
La boucle
VB:
For each wk in Workbooks
Permet donc si je comprends bien de parcourir les différents classeurs ouvert.
Mon pb est que les feuilles ne s'appel pas toute "017-IRMM100" je voudrais simplement appliquer mon script à la première feuille de chaque classeur. Je dis la 1er feuille car il n'y a qu'une feuille ^^.

Bonne journée et merci
 

Kapioss

XLDnaute Nouveau
Bonjour je vous remercie pour votre aide,
Après avoir implémenté votre code j'ai malheureusement une incompatibilité de type (erreur 13) et je n'arrive pas a résoudre le pb depuis 2j.
Pourriez vous m'aider ? En faisant executer jusqu'au curseur j'ai découvert que le problème venait du moment ou je défini mes variable moy, SD, moytest et SDtest mais je n'arrive pas a résoudre le pb
Re,

Par wk.Sheets(1) 'Première feuille du classeur
Ou wk.WorkSheets(1) si on veut exclure les feuilles graphiques ou autres



Cordialement




Merci à vous
VB:
Sub precision_interne234U()

Dim j As Integer
Dim i As Integer
Dim moy As Double
Dim SD As Double
Dim moytest As Double
Dim SDtest As Double
Dim wk As Workbook



'on nomme les cellules de debut ou l'on mettra les différents résultat
For Each wk In Workbooks

    With wk.Sheets(1)
    
    .Cells(57, 2) = "mean"
    .Cells(58, 2) = "StdDev(abs)"
    .Cells(59, 2) = "StdDev(%)"
    
'boucle for qui permettra de parcourir les colonne et donc de faire les isotopes 234U à 238U qui sont des colonnes 3 à 6, on parcours donc les colonnes 3 à 6

    For j = 3 To 9
        
    
        moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
        moytest = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SDtest = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) + 1
        
        'paramètre de test arbitraire on fera des test pour voir ce qui est le plus adequat 50%, 75% 80% etc
        Do Until SDtest - SD = 0
        
        'on parcours les lignes 24 à 53 où les 30 mesures d'un isotope sont avec la boucle for
            For i = 24 To 53

                If .Cells(i, j) >= 2 * SD + moy Then .Cells(i, j) = Empty
                If .Cells(i, j) <= 2 * SD - moy Then .Cells(i, j) = Empty
            
            Next
            
            'on stocke l'ancienne moyenne et l'ancien SD dans les variables XXXtest pour faire ensuite le test du while
            moytest = moy
            SDtest = SD
            moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
            SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
            
        Loop
        
        'on calcule les moy et SD finaux et on les affiche dans tel ou tel colonnes/lignes correspondante
        moyfinal = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SDfinal = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) * 2
        .Cells(57, j).Value = moyfinal
        .Cells(58, j).Value = SDfinal
        .Cells(59, j).Value = (SDfinal / moyfinal) * 100
      
        
    Next

    
    End With
    
    wk.Save
    
Next wk


End Sub
 

Hasco

XLDnaute Barbatruc
Bonjour,

Je veux bien vous aider mais sans au moins deux classeurs dont celui qui a la macro c'est difficile de deviner certaines choses. De plus vous ne dites pas sur quelle ligne vous avez l'erreur.

La seule chose que je vois c'est que vous faites appel à des fonctions de feuille de calcul (Average, Stdev, ) qui peuvent retourner des erreurs de l'énumération xlCvErr

Par exemple Average et Ecart Type (stDev) peuvent retourner xlErrDiv0 (= #DIV/0! d'une feuille de calcul) ou xlErrNum ( =#Nombre!)

Il faut donc déclarer les variables devant contenir le résultat en Variant et tester le résultat

VB:
Dim moy As Variant

'....

moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)

If isError(moy) Then
   ' faire quelque chose si erreur
Else
    ' faire autre chose si pas d'erreur
End If

Vous pouvez aussi simplement les déclarer en Variant et ne pas les tester. Les cellules contiendront les erreurs (#Div/0! pour moy et StDev)

Peut-être que faisant comme ça vous verrez ce qui cloche dans vos données ou votre code.

Cordialement
 

Hasco

XLDnaute Barbatruc
Re,

Je vois aussi que dans votre macro vous ne tester pas les noms des classeurs. Si le classeur qui contient la macro ne doit pas être traité, il faut l'exclure de votre boucle.

VB:
For Each wk In Workbooks
  ' Ne pas traiter le classeur de cette macro
  If wk.Name <> ThisWorkbook.Name Then
    With wk.Sheets(1)
     '.... reste de code'
    End With
   End If
 Next

Cordialement
 

Kapioss

XLDnaute Nouveau
Bonjour et merci,

j'ai déclaré mes variables moy et sd en variant et ma macro est dans un classeur qui est a traité donc pas de problème de ce coté si.
J'ai encore la même erreur même en déclarant mes variables en variant. Je vous joints 2 fichiers pour que vous puissiez voir la "tête" de mes fichier et le 017-IRMM100 contient le script.

Merci,
Bonne journée
 

Pièces jointes

  • 007-IRMM10.xlsm
    14.3 KB · Affichages: 10
  • 017-IRMM100.xlsm
    21.2 KB · Affichages: 4

Hasco

XLDnaute Barbatruc
Re,

Comme je vous le disais, vous avez ces erreurs sur des colonnes vides ou avec des valeurs 0.

Vos feuilles n'ont pas focément 9 colonnes à traiter aussi, j'ai rajouté également une variable qui récupère le dernier n° de colonne à traiter.

Pour les colonnes en 0 j'ai rajouté une ligne pour les sommer avant le traitement si somme >0
Pour le reste, je ne sais pas trop, puisque votre code :
VB:
'on parcours les lignes 24 à 53 où les 30 mesures d'un isotope sont avec la boucle for
                        For i = 24 To 53

                            If .Cells(i, j) >= 2 * SD + moy Then .Cells(i, j) = Empty
                            If .Cells(i, j) <= 2 * SD - moy Then .Cells(i, j) = Empty

                        Next
Parfois vide toute une colonne et que les récupérations suivantes des moyennes et ecarttype vont donc planter.

Dans le fichier joint, pour les moyennes et ecarttype finaux, la macro mets 0 si le test IsError(...) est vrai

A vous (je ne suis pas de votre domaine) de prendre les mesures nécessaires sur ce que vous voulez faire. En cas de colonne vidée par vos tests.

J'ai mis en commentaire des lignes de gestion d'erreur pour le débogage
' On error resume next
et des
' If err>00 then Stop : Err.Clear

Pendant vos test, décommentez en premier le On error resume next
Si une erreur se produit ensuite, la macro s'arrêtera au prochain If err>0 ...
Faites 'Affichage/Variables locales' et consulter l'état de vos variables, cela vous aidera à cerner les problèmes.

Si vous voyez que la variable 'moy' est = 2007 (xlErrDiv0) c'est qu'il y a une erreur de division par zéro
La aussi c'est à vous de prendre les mesures nécessaires.

Cordialement
 

Pièces jointes

  • 017-IRMM100.xlsm
    36.3 KB · Affichages: 1
Dernière édition:
Haut Bas