Macro qui ne fonctionne plus lorsque je change de PC

Le 18/11/2024 à 18:07

Bonjour,

J'ai créé une macro qui me permets de copier des données du fichier excel "INSCRIPTIONS" depuis la feuille " LISTE" vers le classeur " COURSES JEUNES " feuille "INSCRIPTION " . Elle fonctionne parfaitement , mais si j'utilise un autre PC, j'ai le message d'erreur : " Erreur d'exécution '9' : L'indice n'appartient pas à la sélection .

Ci dessous ma macro et ci joint le fichier excel "INSCRIPTIONS" et le classeur "COURSES JEUNES "

Merci d'avance pour votre aide.

Sub TELECHARGERDONNEES()
'
' TELECHARGERDONNEES Macro
'Détermine le chemin
Const Cible = &H10 'Desktop
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
Chemin = objFolderItem.Path
'Enregistre le fichier
Fichier = "COURSES JEUNES"
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & Fichier & ".xlsm"

Windows("INSCRIPTIONS .xlsx").Activate
Sheets("LISTE").Select
Range("A2:M2058").Select
Selection.Copy
Windows("COURSES JEUNES.xlsm").Activate
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2:N2").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.ScrollColumn = 1
Range("E2").Select
ActiveWorkbook.Worksheets("INSCRIPTION").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("INSCRIPTION").AutoFilter.Sort.SortFields.Add Key:= _
Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal

With ActiveWorkbook.Worksheets("INSCRIPTION").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
' TRIETS Macro
'

Columns("O:Q").Select
Selection.EntireColumn.Hidden = False

Range("I3:I2500").Select
Selection.Copy

Range("P3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$P$2:$P$2500").RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("P2").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("INSCRIPTION").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("INSCRIPTION").AutoFilter.Sort.SortFields.Add Key:= _
Range("P2:P19"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("INSCRIPTION").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Columns("P:P").Select
Selection.EntireColumn.Hidden = True

Selection.AutoFilter

End Sub

edit modération : code mis entre balises code via bouton </> merci d'y penser à l'avenir

13inscriptions.xlsx (166.70 Ko)
16courses-jeunes.zip (364.14 Ko)
Le 18/11/2024 à 18:52

Bonjour,

Peut-être en enlevant l'espace dans le nom de ce classeur :

Windows("INSCRIPTIONS .xlsx").Activate

Vérifiez aussi que la feuille INSCRIPTION existe bien dans le classeur.

Il faudrait nous dire sur quelle ligne cela bloque.

Le 18/11/2024 à 19:29

Bonjour Jean Paul, j'ai déja essayé de supprimer l'espace et la feuille INSCRIPTION existe bien.

Lorsque je fait débogage, ci dessous la ligne soulignée et en gras qui apparait en surlignage jaune dans la macro lors du débogage.

Sub TELECHARGERDONNEES()
'
' TELECHARGERDONNEES Macro
'Détermine le chemin
Const Cible = &H10 'Desktop
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
Chemin = objFolderItem.Path
'Enregistre le fichier
Fichier = "COURSES JEUNES"
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & Fichier & ".xlsm"



Windows("INSCRIPTIONS .xlsx").Activate
Sheets("LISTE").Select
Range("A2:M2058").Select

Le 19/11/2024 à 06:08

Bonjour,

Peut-être ceci: Le nom du classeur est "inscriptions" écrit en minuscules, alors que dans la macro, c'est: "Windows("INSCRIPTIONS .xlsx").Activate" en majuscules.

Pour palier cela, mettez tout en haut du module et avant la macro "Option compare text"

Cdlt

Le 19/11/2024 à 14:07

Bonjour,

Il faut bien vérifier les noms de fenêtres...

000025

Quelques conseils qui vous éviterons de foncer dans le mur :

  • Utiliser des fonctions au lieux de répéter un code exemple pour récupérer le chemin du bureau (mettre ce code dans un module nommé Functions)
Option Explicit

Private Const Desktop As Integer = &H10
Private Const Documents As Integer = &H5
Private Const Favoris As Integer = &H6
Private Const History As Integer = &H22
Private Const Music As Integer = &HD
Private Const Pictures  As Integer = &H27
Private Const Videos As Integer = &HE
Private Const Programs As Integer = &H2
Private Const Startup As Integer = &H7

'@Description "Récupère le chemin du bureau."
Public Function getDesktopPath(Optional DirectoryConst As Variant = &H10) As String
    Dim objShell As Object
    Dim objFolder As Object, objFolderItem As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(DirectoryConst)
    Set objFolderItem = objFolder.Self
    Dim Chemin As String
    Chemin = objFolderItem.Path
    getDesktopPath = Chemin
End Function

'@Description "Ajoute un backSlash à la fin du chemin si nécessaire."
Public Function AddBackslash(ByVal FolderPath As String) As String

    FolderPath = Trim$(FolderPath)
    If Right$(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    AddBackslash = FolderPath
End Function

Et pour l'appel :

    Const COURSES_JEUNES As String = "COURSES JEUNES.xlsm"
    Dim Chemin As String
    Chemin = AddBackslash(Functions.getDesktopPath) ' // Chemin du bureau par défaut
    ActiveWorkbook.SaveAs Filename:=Chemin & COURSES_JEUNES
  • Évitez les Select et Activate qui ne font que ralentir et transformer votre classeur en sapin de noël.
  • Utilisez des tableaux structurés. Cela rendra votre code plus clair et plus simple.
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 3
        ActiveWindow.ScrollColumn = 4
        ActiveWindow.ScrollColumn = 5
        ActiveWindow.ScrollColumn = 6
        Columns("O:Q").Select
        Selection.EntireColumn.Hidden = False
        ActiveWindow.ScrollColumn = 5
        ActiveWindow.ScrollColumn = 4
        ActiveWindow.ScrollColumn = 3
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 1
        Range("I3:I2500").Select
        Selection.Copy
        ActiveWindow.ScrollRow = 2482
        ActiveWindow.ScrollRow = 2467
        ActiveWindow.ScrollRow = 2431
        ActiveWindow.ScrollRow = 2416
        ActiveWindow.ScrollRow = 2400
        ActiveWindow.ScrollRow = 2385
        ActiveWindow.ScrollRow = 2364
        ActiveWindow.ScrollRow = 2344
        ActiveWindow.ScrollRow = 2323
        ActiveWindow.ScrollRow = 2303
        ActiveWindow.ScrollRow = 2282
        ActiveWindow.ScrollRow = 2251
        ActiveWindow.ScrollRow = 2226
        ActiveWindow.ScrollRow = 2195
        ActiveWindow.ScrollRow = 2164
        ActiveWindow.ScrollRow = 2128
        ActiveWindow.ScrollRow = 2087
  • Ce type de code est inutile.....
  • Déclarez vos variables explicitement. (Mettre Option Explicit en tête de chaque modules)
  • Idem sur le code des feuilles (Des boutons et des déclarations sont manquantes)
  • Déclarer les fonctions :
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

'Private Sub CommandButton1_Click()
'  'Bouton départ de la course
'  CommandButton1.Visible = False
'  CommandButton2.Visible = True
'  Range("A7:A606").ClearContents
'  [H4] = Time: [H6] = "": [A7].Select
'  SetTimer Application.hwnd, 0, 1000, AddressOf UpDateTime
'End Sub
'Private Sub CommandButton2_Click()
'  'Bouton fin de la course
'  CommandButton1.Visible = True
'  CommandButton2.Visible = False
'  [H6] = Time: [A1].Select
'  KillTimer Application.hwnd, 0
'End Sub

Bonne programmation.

Le 21/11/2024 à 08:31

Bonjour Jean Paul,

Un grand merci pour votre réponse, mais hélas trop compliquée pour moi. En effet je n'ai aucune notion en programmation et toutes les macros dans le classeur joint ont été faites principalement avec l'enregistreur de macro ou quelques-unes unes, trouvées sur internet.

Je ne sais pas ,si vous avez ouvert les classeurs et tester la macro " TELECHARGER LES DONNEES" , qui fonctionne su rle PC sur lequel je l'ai créé mais bugue sur un autre comme je l'ai indiqué dans ma question. En fait je cherche quelqu'un qui me corrige cette macro afin qu'elle fonctionne sur tous les pc.

Encore merci et bonne journée.

Le 21/11/2024 à 11:17

bonjour,

Le message d'erreur indique qu'il ne trouve pas la fenêtre excel "INSCRIPTIONS .XLSX", regarde si tu as bien une fenêtre nommée "INSCRIPTIONS .XLSX" avant de cliquer sur le bouton "télécharger données"

le fichier inscriptions que tu as mis ne contient pas l'espace requis avant le .XLSX

Rechercher des sujets similaires à "macro qui fonctionne lorsque change"