Forum du club des d�veloppeurs et IT Pro - Macros et VBA Excel

[XL-365] Somme de plusieurs colones avec crit�re

Zeltron59 — Mon, 13 Jul 2026 11:44:36 GMT

Bonjour le Forum

Existe t il une formule qui me permettrai de calculer la somme de plusieurs colonnes avec un crit�re

exclure les tirets
exclure les colonnes D c'est � dire les colonnes qui calcule la diff�rence entre les colonnes M et C
Merci d'avance pour votre aide.

J'ai tent� avec SOMME.SI.ENS sans succ�s

Fichiers attach�s

Classeur1.xlsm (12,0 Ko)

[XL-365] Creation d'une liste ou non dans une celulle en fonction d'une condition

xavutrecht — Wed, 08 Jul 2026 15:51:15 GMT

Bonjour,

Je suis devant un petit probl�me.
Je cherche � placer dans une celulle soit une valeur soit une liste avec le premier �l�ment de la liste "actif".

J'ai un test sur Sheet1.A20 qui renvoie TRUE ou FALSE. La formule regarde si la celulle Sheet1.A1 est vide ou non.
2 cas:
Si TRUE alors une la valeur en Sheet1.A1 est copi�e en A21 est "envoy�e" dans Sheet2.B1
Si FALSE alors une liste situ�e en Sheet3.A1:A10 est "plac�e" dans Sheet2.B1

Des calculs sont faits en fonction de la valeur de la celulle en Sheet2.B1, il est important que la celulle ne soit pas vide.

J'ai essay� de faire cela avec un Sub Worsheet_Change mais j'ai lamentablement �chou�. Rien ne se pass lorsque je change la valeur en Sheet1.A1.
Voici un extrait du code.

Je suis aussi preneur d'une solution sans VBA.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1")) Is Nothing Then
    Application.EnableEvents = False
    With ThisWorkbook.Worksheets(Sheet2).Range("B1")
      If ThisWorkbook.Worksheets(Sheet1).Range("A20").Value Then
        .Clear
        .Value = ThisWorkbook.Worksheets(Sheet1).Range("A21").Value
      Else
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, Formula1:="=Data_trajets_noms"
        'If you don't want the first list value of Data_trajets_noms put into B8 then remove the next line of code
        .InCellDropdown = True
        .Value = ThisWorkbook.Worksheets(Sheet3).Range("A1:A10").Cells(1).Value
      End If
    End With
    Application.EnableEvents = True
  End If
End Sub

[XL-2016] Rester sur la page en cours lors de l'ex�cution d'une Macro avec Power Query

excelator26 — Tue, 07 Jul 2026 18:54:04 GMT

Bonjour,

Je viens demander de l'aide � propos de ce code VB Excel sur lequel je buche depuis un certain temps.
Je veux ex�cuter une s�rie de Macros avec la fonction Call tout en restant sur la feuille actuelle (mode silencieux); ne pas afficher (ou parcourir) les feuilles concern�es par le code car ne souhaitant pas que ces feuilles soient vues.
Le souci est li� � la Macro qui actualise les donn�es dans les tableaux Excel avec les requ�tes Power query; quoi que je fasse, ces tableaux de donn�es s'affichent toujours comme le montre cette vid�o: https://jumpshare.com/s/NH7nsQ6I2S8X7oWFWCTN

Comment y rem�dier?
Code � ex�cuter en premier:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim RunTime As Double
 
Sub RunFirstMacro()
    Dim StartingSheet As Worksheet
    Set StartingSheet = ActiveSheet
 
    Dim Response As Integer
    Response = MsgBox("Are you sure you want to run this macro? This action cannot be undone. Temps estimé: 05 minutes", _
               vbYesNo + vbQuestion + vbDefaultButton2, "Confirm Execution")
 
      If Response = vbNo Then
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
    Call RefreshQueryTable
    Call InsertionSommeSiEnsCAClientsJAN
    Call InsertionSommeSiEnsRGTClientsJAN
    Call InsertionSommeSiEnsENGFssJAN
    Call InsertionSommeSiEnsPAYFssJAN
 
    StartingSheet.Activate
    Set StartingSheet = Nothing
 
    MsgBox "First macro has finished! Le processus va maintenant ajuster les colonnes. Cliquez sur Ok. Merci de patienter encore une dizaine de secondes."
 
    RunTime = Now + TimeValue("00:00:02")
 
     Application.OnTime RunTime, "RunSecondMacro"
     Application.ScreenUpdating = True
End Sub

Code pour rafra�chir les tableaux des donn�es (Power query) posant probl�me:

Code:

1
2
3
4
5
6
7
8
Sub RefreshQueryTable()
 
    ThisWorkbook.Sheets("Engagements").ListObjects("Engagement__2").QueryTable.Refresh BackgroundQuery:=False
    ThisWorkbook.Sheets("Op_Bque").ListObjects("Op_Bque__2").QueryTable.Refresh BackgroundQuery:=False
    ThisWorkbook.Sheets("CLOTURE_C.A._JAN").ListObjects("Fact_Clts_Jan").QueryTable.Refresh BackgroundQuery:=False
    ThisWorkbook.Sheets("CLOTURE_CAISSE_JAN").ListObjects("Tableau_DonnéesExternes_1").QueryTable.Refresh BackgroundQuery:=False
 
End Sub

Au besoin, je peux joindre les fichiers Excel avec tous les codes.

Cordialement.

[Toutes versions] Trier un tableau, suppression des "vides" et des doublons

DenisHen — Sat, 04 Jul 2026 08:31:37 GMT

Bonjour � la communaut�.

Dans un classeur, j'alimente des ComboBox du ruban depuis plusieurs listes contenu dans des colonnes.

Capture du ruban :

Les bouton de droite servent � ajouter ou remplacer le contenu des cellules dans d'autres onglets pour les calculs ou les commandes.

Et petite capture de l'onglet :

Pour me facilit� le boulo, j'ai nomm� les cellules d'ent�te :
B2 (Protect) = "SPMProtect"
C2 (Nom) = "SPMProtectNom"
D2 (D�signation)= "SPMProtectDesign"

Et mon extrait du ruban pour cette partie :

Code:

1
2
3
"XlsSPMProtect"        label="Protection :"  onChange="ChangSPMProtect"       sizeString="####################" getItemCount="NbSPMProtect"       getItemLabel="LabelSPMProtect"       invalidateContentOnDrop="true" />
"XlsSPMProtectNom"     label="Nom :"         onChange="ChangSPMProtectNom"    sizeString="####################" getItemCount="NbSPMProtectNom"    getItemLabel="LabelSPMProtectNom"    invalidateContentOnDrop="true" />
"XlsSPMProtectDesign"  label="Désignation :" onChange="ChangSPMProtectDesign" sizeString="####################" getItemCount="NbSPMProtectDesign" getItemLabel="LabelSPMProtectDesign" invalidateContentOnDrop="true" />

J'organise mon code VBA avec :

Code:

1
2
3
  FeuilSPMLstProtect = Range("SPMLstProtect").Worksheet.Name
  LignSPMLstProtect = Range("SPMLstProtect").Row + 1
  ColSPMLstProtect = Range("SPMLstProtect").Column

Ce qui permet de renommer les onglets, ajouter des colonnes... Car je ne suis pas seul � utiliser ce classeur, mais le seul � "coder" (en amateur bien sur).

Je ne sais pas comment alimenter mon Combo "XlsSPMProjet" sans doublons.

Donc, je passe par un tableau que je rempli, je fais un tri � bulle pour l'ordre alphanum�rique et je colle le tout dans une colonne (AA2), et c'est cette colonne qui alimente mon combo "XlsSPMProtect", et qui conditionne le second Combo "XlsSPMProtectNom", et je refait cette technique pour tous mes Combo (et j'en ai d'autres). Cette partie est d'environ 200 lignes, d'autres en ont plus.

Je pense qu'il doit il y avoir une m�thode pour �a, mais je ne la trouve pas.

J'esp�re avoir �t� assez clair et compr�hensible.

Si quelqu'un(e) a une id�e, un conseil, une astuce, je suis preneur.

Bien � toi, la communaut�.

Denis...

Images attach�es

[XL-365] Formule de classement final du tableau trixtettes

tigre5 — Wed, 24 Jun 2026 20:27:58 GMT

Bonsoir,
qui pourrait m'aider a mettre la formule dans le classement final du tableau trixtettes
je n'arrive pas a mettre la formule dans le classement final pour le nombre de victoire de chaque �quipes ainsi que les noms et la lettre de chaque �quipes
je voudrais l'employ� ce samedi dans mon nouveau club de p�tanque
je dis d�j� un grand merci a tout ceux qui voudraient m'aider a r�aliser mon tableau final
je joins mon fichier d�j� fait en partie
pour le nombre de victoire il faut que l'�quipe qui gagne 13-8 par exemple dans le tableau du classement final doit apparaitre 1 victoire a l'�quipe gagnante et 0 a l'�quipe perdante for ever sj trixtettes.xlsx for ever sj trixtettes.xlsx
je dis encore merci d'avance

Fichiers attach�s

for ever sj trixtettes.xlsx (37,7 Ko)

[XL-365] Export d'une image

retraite83 — Sat, 13 Jun 2026 10:15:32 GMT

Bonjour,

je veux exporter une photo depuis une cellule d'une feuille vers un dossier externe

J'ai trouv� et adapt� autant que je sache le faire du code trouv� :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Option Explicit
Sub ExportphtoH(nomphto)
 
Dim  phtoH As Worksheet, rng As Range, shTmp As Worksheet, chtTemp As Chart, pathPhtoH As String
 
Application.ScreenUpdating = False
 
Set phtoH = Sheets("Photo")
 
pathPhtoH = Thisworkbook.path & "\TEST\" & nomphto
Set rng = phtoH.Range("D15")
 
Set shTmp = Worksheets.Add
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=shTmp.Name
 
Set chtTemp = ActiveChart
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
chtTemp.Paste
chtTemp.Export Filename:=pathPhtoH
 
Application.DisplayAlerts = False
shTmp.Delete
Application.DisplayAlerts = True
 
End Sub

Le code marche bien � un d�tail (important) pr�s :
avant d'ex�cuter la ligne :

Code:

chtTemp.Export Filename:=pathPhtoH

Je contr�le la photo dans la feuille temporaire elle est bien l� mais la taille n'est plus celle de la photo d'origine en phtoH.Range("D15"), elle est plus petite, donc pr�sente mais plus petite �galement dans le dossier d'export..

Je me dis �galement qu'on doit pouvoir exporter directement la photo d'origine en phtoH.Range("D15")

Beaucoup de test sans pouvoir aller plus loin

[XL-365] Envoi de mail avec thunderbird

RANDOLOISIRS — Fri, 12 Jun 2026 07:11:06 GMT

Bonjour,
Je viens de changer d'ordinateur car mon ancien ordinateur a rendu l'�me. Je passe d'Excel 2010 � Exel 2024.
Mes macros VBA Excel qui marchaient tr�s bien en Excel 2010, ne marchent plus en Excel 2024 pour l'envoi des messages avec Thunderbird. Pouvez-vous m'aider.

Voici la macro :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
                    sujet = "Création du document d'inscription pour la " & NomRando & " du " & DateRando & "."
            sujet = Replace(Replace(Replace(Replace(sujet, "-", " "), "  ", " "), "  ", " "), " .", ".")
 
 
 
 
            body = "Bonjour " & NomInscriptionHelloAsso & "," & "
" & "
" & _
            "Nous programmons la " & NomRando & " pour le " & DateRando & " " & DépartParking & ". 
 
" & " Animateur : " & NomAnimateur1 & " Téléphone : " & TelAnimateur1 & _
            " Adresse courriel : " & AdresseAnim1 & "
" & TexteDeuxièmeAnim & _
            "
" & "
" & "Tu voudras bien créer le document d'inscription pour cette randonnée, ( " & LCase(Worksheets("Configurations").Range("B11")) & ", " & LCase(Worksheets("Configurations").Range("B13")) & " ), donner l'accès" & TexteComplémentaire & _
            "
" & "
" & "Retourne moi ensuite le lien d'accès au document d'inscription afin que je puisse l'insérer dans la fiche d'information avant sa diffusion." & "
" & TexteInscriptionHelloCDRP & "
" & "
" & "Cordialement" & "
" & "
" & NomUtilisateurComplet & "
 " & "
 " & " _ "
 
 
            body = Replace(Replace(Replace(Replace(body, "-", " "), "  ", " "), "  ", " "), " .", ".")
 
            ' recherche de l'adresse mail de l'animateur
 
 
             cc = ""
            Cci = ""
 
            strcommand = messagerie
            strcommand = strcommand & " -compose " & "to='" & destinataire & "'"
            strcommand = strcommand & "," & "cc='" & cc & "'"
            strcommand = strcommand & "," & "bcc='" & Cci & "'"
            strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
            strcommand = strcommand & "body='" & body & "'"
 
         If fichierjoint <> "" Then
            strcommand = strcommand & "," & "attachment=file:///" & fichierjoint
        End If
 
         Call Shell(strcommand, vbNormalFocus)

Dans le mail qui se cr�e apparait, l'adresse et le premier mot du sujet avec ' en premier soit pour cet exemple 'Cr�ation. Il n'y a pas de body

[XL-365] Contr�le pr�sence d'un r�seau

retraite83 — Sat, 30 May 2026 14:47:50 GMT

Bonjour,

j'ai l'habitude de contr�ler la pr�sence d'un fichier par :

Code:

If Len(Dir(pathServeur, vbDirectory)) > 0 Then

Comment faire pour contr�ler la connexion � un serveur dont l'adresse a la forme

Citation:

\\192.xxx

puis la pr�sence d'un fichier sur ce r�seau

Avez-vous une piste de doc sur ce sujet, mes recherches ne sont pas concluantes

merci

[XL-2019] Blocage impr�vu en VBA

jacsimo — Tue, 26 May 2026 20:50:50 GMT

Bonjour
Je cherche � ranger les colonnes de la feuille ff de la m�me mani�re que celles de la feuille og en fonction des noms qui sont sur la premi�re ligne. Je prends les noms de og un par un, je cherche o� ils se trouvent dans ff et je d�place les colonnes de ff pour les mettre dans le m�me ordre que dans og.
J'utilise une s�quence a priori identique � celle que j'ai d�j� utilis�e ailleurs et qui fonctionne sans probl�me. Mais ici, quand j'ai trouv� le nom dans ff, par find, je bloque sur la position de la colonne, sur la ligne col = nomf.Column, j'ai une erreur 424, objet requis.
Quelqu'un peut-il me dire ce que j'ai rat� ou ce que je dois ajouter ?
Merci d'avance.

Je n'arrive pas � mettre ma proc�dure en PJ, je la reproduis ici:

Dim shg As Worksheet
Set shg = Worksheets("og")
Dim shf As Worksheet
Set shf = Worksheets("ff")

'rang des derni�res colonnes de og et ff
lastcog = shg.Cells(1, Columns.Count).End(xlToLeft).Column
lastcff = shf.Cells(1, Columns.Count).End(xlToLeft).Column

'd�finition de la plage de recherche
Set rgff = shf.Range(shf.Cells(1, 4), shf.Cells(1, lastcff))

For j = 4 To lastcog
nom = shg.Cells(1, j)
If nom <> "" Then
nomf = rgff.Find(nom, LookIn:=xlValues, lookat:=xlWhole) 'recherche du nom dans ff
col = nomf.Column
shf.Columns(col).Cut
shf.Columns(j).Insert shift:=xlToRight
Else
'� traiter
End If
Next j

Fichiers attach�s

ma proc�dure qui plante.txt (776 octets)

[XL-365] Plantage � la fermeture d'un classeur

lesurferdu59 — Tue, 26 May 2026 15:00:24 GMT

Bonjour,

J'ai un classeur qui plante en le fermant en VBA. En fait, je veux que mon classeur se ferme (mais sans quitter Excel car les autres classeurs doivent rester ouverts) en faisant un clic DROIT sur une cellule.

Pour v�rifier si cela ne vient pas du code, j'ai fait un nouveau classeur tout b�te avec uniquement (et rien d'autre) :

Sur la feuille, une proc�dure �v�nementielle :
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If ActiveCell.Address = "$F$10" Then
ThisWorkbook.Close True
End If
End Sub

Si je fais un clic DROIT en F10, mon classeur fait quitter Excel, mais je dirai fait "planter" Excel, car lorsque je le relance, j'ai un message indiquant qu'Excel ne s'est pas ferm� correctement et me demande si je veux l'ex�cuter en mode sans �chec...
Bien s�r, les autres classeurs ouverts sont ferm�s en m�me temps, et s'ils n'�taient pas enregistr�s, tout est perdu...

J'ai essay� sans ouvrir d'autres classeur, m�me chose

J'ai essay� avec la proc�dure �v�nementielle double clic : m�me probl�me

J'ai essay� avec la proc�dure �v�nementielle Worksheet_SelectionChange : l� �a fonctionne, Excel ferme mon classeur mais reste ouvert. Par contre, cette proc�dure ne m'int�resse pas, car si je clique par erreur sur la cellule, il va se fermer, et je ne souhaite pas de message demandant si je veux vraiment fermer le classeur.

J'ai essay� aussi, au lieu d'utiliser directement l'instruction ThisWorkbook.Close de faire un call proc�dure et mettre le close dans une proc�dure, toujours la m�me anomalie.
j'ai recherch� sur diff�rents sites, (mettre un do events, mettre workbooks("nomclasseur").close � la place de thisworbook, etc), mais rien ne fonctionne.

Donc, pour r�sumer, est-ce que quelqu'un sait pourquoi :
en utilisant l'instruction ThisWorkbook.Close dans une proc�dure �v�nementielle BeforeRightClick ou BeforeDoubleClick �a fait planter Excel, alors qu'avec une proc�dure SelectionChange le classeur se ferme bien en laissant Excel ouvert ???

Merci d'avance.

[XL-365] VBA Modification reference cellule

Gestion-RH — Tue, 26 May 2026 10:04:23 GMT

Bonjour
Dans le cadre d'un planning, j'utilise ce code pour transposer des cycles de travail dans une grille de distribution qui rempli automatiquement un calendrier perp�tuel.
Je souhaite positionner la plage � copier sur le 1er lundi du mois (4�me jour de l'ann�e par exemple). Cette valeur se calcul automatique et se range dans la cellule P1
ainsi au lieu de Range("E3").Select, je souhaite obtenir Range("E3"+4).Select, soit au final Range("E7").Select
Le sujet semble si �vident que le nombre de r�ponses est "assourdissant".
Auriez-vous la bont� de m'aider SVP.
Merci d'avance

Private Sub CommandButton1_Click()
Dim r�ponse As Integer
Dim PLAGE As Range
r�ponse = MsgBox("Vous allez importer le cycle de travail dans les grilles mensuelles : Voulez-vous continuer ?", vbQuestion + vbYesNo)
If r�ponse = vbYes Then
Application.ScreenUpdating = False
' Transport du cycle 01 Sem dans la grille de distribution
Set PLAGE = Worksheets("CYCLE").Range("S3:AA9")
PLAGE.Copy
Range("S3:AA9").Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
etc.

[XL-365] Contr�le num�rique d'un champ

retraite83 — Fri, 22 May 2026 09:16:01 GMT

Bonjour,

je viens de d�couvrir qq chose que je n'avais jamais remarqu� dans un contr�le num�rique :

Un champ A1 d�fini en num�rique
L'utilisateur tape un espace dans sa saisie par exempe "12 4"
Le code suivant contr�le la num�ricit�

Code:

1
2
3
4
5
6
 
    If IsNumeric(test.Range("A1")) = True Then
       MsgBox "OK"
    Else
        MsgBox "champ non numérique", Title:=titre
    End If

le contr�le r�pond "OK"

Mais ensuite la macro se plante dans un calcul avec la valeur du champ

Manque-t-il qq chose dans mon test, j'avoue �tre surpris et ne pas voir l'erreur de mon code VBA

[XL-2010] Modifier code vba.

atlaslion1962 — Wed, 20 May 2026 10:12:38 GMT

bonjour tout le monde.
Modifier ce code qui fonctionne pour prendre en charge la langue des appr�ciations. De plus, en analysant pr�cis�ment l'onglet "الملاحظات" de votre fichier ma�tre الملاحظات.xlsm :
� La colonne I (9) contient les mati�res en AR (العربية, التربية الإسلامية, الاجتماعيات...).
� La colonne J (10) contient les mati�res en FR (الفرنسية, الرياضيات, الفيزياء...).
� La colonne K (11) contient la mati�re en EN (الانجليزية).
Ce code doit am�liorer votre version existante pour :
� D�tecter automatiquement la langue de la mati�re ;
� Utiliser les colonnes I / J / K de l�onglet الملاحظات ;
� Appliquer automatiquement les appr�ciations AR / FR / EN ;
� G�rer plusieurs professeurs et plusieurs niveaux ;
� �viter les doublons de fichiers ;
� Fonctionner avec les fichiers Massar.
Ce qui doit �tre am�lior�
1. D�tection intelligente de la langue
Le code utilise maintenant :
� Colonne I → mati�res AR
� Colonne J → mati�res FR
� Colonne K → mati�res EN
Exemple :
� الرياضيات → FR
� الفيزياء والكيمياء → FR
� الانجليزية → EN
� التربية الإسلامية → AR
________________________________________
2. Compatible avec les fichiers Massar
Le code d�tecte automatiquement :
� La colonne des appr�ciations ;
� La colonne des notes ;
� La ligne de d�but des �l�ves.
________________________________________
3. Gestion automatique des appr�ciations
Selon la langue d�tect�e :
� AR → colonne C
� FR → colonne D
� EN → colonne E
________________________________________
4. Gestion de plusieurs professeurs
Le programme :
� Demande le nombre de professeurs ;
� Demande les niveaux ;
� Permet une s�lection multiple des fichiers ;
� �vite les doublons.
________________________________________
Important
Dans votre feuille الملاحظات :
Colonne Contenu
B Tranches de notes
C Appr�ciations AR
D Appr�ciations FR
E Appr�ciations EN
I Mati�res AR
J Mati�res FR
K Mati�res EN
________________________________________
Conseil important
Pour �viter les erreurs :
� Utilisez toujours les m�mes noms de mati�res ;
� �vitez les espaces inutiles ;
� Gardez les fichiers Massar au format original.
Am�liorations cl�s apport�es au script :
� D�tection dynamique des langues : La fonction interne IsSubjectInCriteria analyse le contenu des colonnes I, J et K de votre feuille الملاحظات pour associer pr�cis�ment la langue correspondante (AR, FR ou EN).
� Extraction intelligente de l'appr�ciation : Le script aiguille le r�sultat automatiquement vers la colonne C (AR), D (FR) ou E (EN) selon la langue valid�e et g�re les formats de tranches de notes de la colonne B (qu'ils soient num�riques ou textuels sous la forme 0-9.99).
� Robustesse Massar : Analyse automatique des 20 premi�res lignes pour rep�rer les mots cl�s exacts de l'en-t�te (Note et Appr�ciation). Si les libell�s varient l�g�rement, un syst�me de repli automatique sur les colonnes standards des matrices Massar est

Option Explicit

' Type personnalis� pour structurer la collection de fichiers par prof/niveau
Private Type ClassFiles
TeacherName As String
LevelIndex As Integer
FilePaths() As String
FileCount As Long
End Type

Public Sub ProcessMultiTeacherGrades()
On Error GoTo ErrorHandler

' --- CONFIGURATION DE L'�CRAN & OPTIMISATION ---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim wbMaster As Workbook
Dim wsCriteria As Worksheet
Set wbMaster = ThisWorkbook

' 1. Lecture de l'onglet ma�tre
On Error Resume Next
Set wsCriteria = wbMaster.Sheets("الملاحظات")
On Error GoTo ErrorHandler

If wsCriteria Is Nothing Then
MsgBox "Erreur : L'onglet 'الملاحظات' est introuvable !", vbCritical, "Erreur"
Exit Sub
End If

' --- �TAPE 1 : Saisie du nombre total de professeurs ---
Dim inputProf As String
inputProf = InputBox("�tape 1 : Saisie le nombre de professeurs � traiter :", "Nombre de Professeurs")

If inputProf = "" Or Not IsNumeric(inputProf) Then
MsgBox "Op�ration annul�e.", vbExclamation, "Fin"
GoTo CleanExit
End If

Dim totalProfs As Long
totalProfs = CLng(inputProf)
If totalProfs <= 0 Then GoTo CleanExit

Dim allGroups() As ClassFiles
Dim groupIndex As Long : groupIndex = 0
Dim dictDup As Object : Set dictDup = CreateObject("Scripting.Dictionary")

Dim p As Long, n As Long, teacherName As String, inputLevels As String, totalLevels As Long

For p = 1 To totalProfs
teacherName = "Professeur " & p
inputLevels = InputBox("�tape 2 : Nombre de niveaux pour " & teacherName & " :", "Niveaux")

If inputLevels = "" Or Not IsNumeric(inputLevels) Then GoTo CleanExit
totalLevels = CLng(inputLevels)

For n = 1 To totalLevels
Dim fd As FileDialog : Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "�tape 3 : " & teacherName & " - Niveau " & n
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Fichiers Excel", "*.xlsx; *.xlsm; *.xls"

If .Show = -1 Then
Dim selectedItem As Variant, localCount As Long : localCount = 0
ReDim Preserve allGroups(0 To groupIndex)
allGroups(groupIndex).TeacherName = teacherName
allGroups(groupIndex).LevelIndex = n

For Each selectedItem In .SelectedItems
If InStr(1, selectedItem, wbMaster.Name, vbTextCompare) = 0 Then
If Not dictDup.Exists(selectedItem) Then
dictDup.Add selectedItem, True
localCount = localCount + 1
ReDim Preserve allGroups(groupIndex).FilePaths(1 To localCount)
allGroups(groupIndex).FilePaths(localCount) = selectedItem
End If
End If
Next selectedItem
allGroups(groupIndex).FileCount = localCount
groupIndex = groupIndex + 1
End If
End With
Set fd = Nothing
Next n
Next p

If dictDup.Count = 0 Then GoTo CleanExit

' Confirmation avant traitement
Dim userConfirm As VbMsgBoxResult
userConfirm = MsgBox("Fin de la s�lection. Pr�t � appliquer les appr�ciations selon les langues d�tect�es ?", vbQuestion + vbYesNo, "Confirmation")
If userConfirm = vbNo Then GoTo CleanExit

' --- CORPS DU TRAITEMENT AUTOMATIQUE DES FICHIERS ---
Dim g As Long, f As Long, wbTarget As Workbook, wsTarget As Worksheet
Dim startRow As Long, appCol As Long, noteCol As Long, lastRow As Long, r As Long
Dim currentGrade As Double, currentAppreciation As String
Dim detectedLang As String, fileName As String

For g = 0 To groupIndex - 1
If allGroups(g).FileCount > 0 Then
For f = 1 To allGroups(g).FileCount

fileName = allGroups(g).FilePaths(f)
Set wbTarget = Workbooks.Open(fileName, UpdateLinks:=0, ReadOnly:=False)
Set wsTarget = wbTarget.Sheets(1)

' D�tection des colonnes et de la langue du fichier
If DetectFileStructureAndLang(wsTarget, fileName, startRow, appCol, noteCol, detectedLang) Then

' Ligne de fin bas�e sur la colonne des noms d'�l�ves (Colonne E dans Massar)
lastRow = wsTarget.Cells(wsTarget.Rows.Count, "E").End(xlUp).Row

For r = startRow To lastRow
' S'assurer que la ligne contient un �l�ve et une note valide
If Trim(wsTarget.Cells(r, "E").Value) <> "" And IsNumeric(wsTarget.Cells(r, noteCol).Value) And wsTarget.Cells(r, noteCol).Value <> "" Then
currentGrade = CDbl(wsTarget.Cells(r, noteCol).Value)

' R�cup�ration de l'appr�ciation correspondante
currentAppreciation = FindAppreciation(wsCriteria, currentGrade, detectedLang)

wsTarget.Cells(r, appCol).Value = currentAppreciation
End If
Next r
End If

wbTarget.Close SaveChanges:=True
Set wbTarget = Nothing
Next f
End If
Next g

MsgBox "Le traitement est termin� avec succ�s !", vbInformation, "Succ�s"

CleanExit:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Exit Sub

ErrorHandler:
MsgBox "Erreur : " & Err.Description, vbCritical, "Erreur"
Resume CleanExit
End Sub

' --- D�TECTION ROBUSTE DE LA STRUCTURE ET DE LA LANGUE ---
Private Function DetectFileStructureAndLang(ByRef ws As Worksheet, ByVal filePath As String, _
ByRef outStartRow As Long, ByRef outAppCol As Long, _
ByRef outNoteCol As Long, ByRef outLang As String) As Boolean
Dim r As Long, c As Long, cellVal As String
Dim subjectText As String
Dim fileName As String

subjectText = ""
fileName = UCase(Mid(filePath, InStrRev(filePath, "") + 1))

' 1. Extraction de la mati�re depuis la zone d'en-t�te Massar (Ligne 11, Colonnes N � P)
subjectText = Trim(ws.Range("O11").Value)
If subjectText = "" Then subjectText = Trim(ws.Range("N11").Value)
If subjectText = "" Then subjectText = Trim(ws.Range("P11").Value)

' 2. Algorithme de d�cision de la langue (Priorit� absolue aux mots-cl�s)
outLang = "AR" ' Par d�faut

' Analyse du texte de la mati�re et du nom de fichier pour l'Anglais
If InStr(1, subjectText, "إنجليزية", vbTextCompare) > 0 Or _
InStr(1, subjectText, "انجليزية", vbTextCompare) > 0 Or _
InStr(1, fileName, "ANGLA", vbTextCompare) > 0 Or _
InStr(1, fileName, "ENG", vbTextCompare) > 0 Then
outLang = "EN"
' Analyse du texte de la mati�re et du nom de fichier pour le Fran�ais
ElseIf InStr(1, subjectText, "فرنسية", vbTextCompare) > 0 Or _
InStr(1, fileName, "FRAN", vbTextCompare) > 0 Or _
InStr(1, fileName, "FREN", vbTextCompare) > 0 Then
outLang = "FR"
End If

' 3. D�finition des lignes et colonnes cibles (Structure type Massar)
outStartRow = 18 ' Les �l�ves commencent toujours � la ligne 18
outAppCol = 15 ' Colonne O (15) pour "ملاحظات الأستاذ"
outNoteCol = 13 ' Par d�faut colonne M (13) "الأنشطة المدمجة" ou "الفرض الثاني"

' Balayage dynamique des en-t�tes (Lignes 16-17) pour s'adapt� si les colonnes bougent
For r = 16 To 17
For c = 1 To 20
cellVal = Trim(ws.Cells(r, c).Value)
If InStr(1, cellVal, "ملاحظات", vbTextCompare) > 0 Or InStr(1, cellVal, "التقدير", vbTextCompare) > 0 Then
outAppCol = c
outStartRow = r + 1
End If
Next c
Next r

' La colonne de note � �valuer est syst�matiquement la colonne num�rique juste � droite des appr�ciations
outNoteCol = outAppCol - 2
If Not IsNumeric(ws.Cells(outStartRow, outNoteCol).Value) Then
outNoteCol = outAppCol - 1
End If

DetectFileStructureAndLang = True
End Function

' --- RECHERCHE DE L'APPR�CIATION TRADUITE ---
Private Function FindAppreciation(ByRef wsCrit As Worksheet, ByVal grade As Double, ByVal langChoice As String) As String
Dim r As Long, minGrade As Double, maxGrade As Double, rangeStr As String, parts() As String
Dim targetCol As Long

' S�lection de la colonne de l'onglet ma�tre selon la langue d�tect�e
If langChoice = "FR" Then
targetCol = 4 ' Colonne D (Fran�ais)
ElseIf langChoice = "EN" Then
targetCol = 5 ' Colonne E (Anglais)
Else
targetCol = 3 ' Colonne C (Arabe)
End If

' Parcours du tableau des tranches de notes (Lignes 4 � 11)
For r = 4 To 11
rangeStr = Replace(Trim(wsCrit.Cells(r, 2).Value), " ", "") ' Colonne B (Tranches)

If rangeStr <> "" Then
' Gestion de la tranche basse "تحت 8"
If InStr(1, rangeStr, "تحت", vbTextCompare) > 0 Or InStr(1, rangeStr, "<", vbTextCompare) > 0 Then
minGrade = 0
maxGrade = 7.99
Else
rangeStr = Replace(rangeStr, ",", ".")
parts = Split(rangeStr, "-")

If UBound(parts) = 1 Then
minGrade = CDbl(parts(0))
maxGrade = CDbl(parts(1))
Else
minGrade = 0 : maxGrade = 0
End If
End If

' V�rification de l'appartenance � la tranche
If grade >= minGrade And grade <= maxGrade Then
FindAppreciation = wsCrit.Cells(r, targetCol).Value
' S�curit� : Si la case traduite est vide, on prend la valeur en Arabe (colonne C)
If Trim(FindAppreciation) = "" Then FindAppreciation = wsCrit.Cells(r, 3).Value
Exit Function
End If
End If
Next r

' Valeur de repli si la note sort des tranches
FindAppreciation = wsCrit.Cells(4, targetCol).Value
End Function
merci

Fichiers attach�s

الملاحظات.xlsm (61,9 Ko)
Export_58685M_2APIC-1_LANGUE ANGLAISE_25032026135833.xlsx (36,7 Ko)

[XL-365] nouveau tableau melee petanque

tigre5 — Sun, 17 May 2026 21:17:35 GMT

bonsoir, quelle est la formule pour le classement des tableaux melee petanque
nouvelle formule du club 12� 18 for ever.xlsx
merci d'avance

Fichiers attach�s

12� 18 for ever.xlsx (32,7 Ko)

[XL-2019] ex�cuter un code XL VBA sur un ipad impossible utiliser un autre langage mais lequel ?

gosselien — Sat, 16 May 2026 15:11:55 GMT

Bonjour,

Pour amusement, je tente d'�crire une petite macro qui me permet de noter tous les num�ros qui sortent lors d'un tirage de BINGO.

J'ai donc une colonne par partie et une colonne qui conserve tout ce qui est sorti pour faire une stat qui donnerait les 3 + sortis et les 3 - sortis.

M�me si je n'ai pas encore termin�, j'ai un peu l'impression que je ne saurai pas faire fonctionner �a sur mon iPad puisque excel iPad ou iPhone ne comprend pas les fichiers macros...

Est-ce que quelqu'un a une solution pour �a et au besoin, faut il programmer sur un autre langage ( ce dont je suis incapable jusqu'� pr�sent...)

Le prg devrait fonctionner sur Windows 11 pour la mise au point mais pour une question d'encombrement sur iPad ensuite.

Merci de votre avis/aide
P.