L'Indice n'appartient pas ..... [Résolu/Fermé]

Signaler
Messages postés
113
Date d'inscription
vendredi 19 janvier 2018
Statut
Membre
Dernière intervention
16 février 2020
-
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
-
Bonjour,



J'espère que quelqu'un peut m'aider.

J'obtient le message (L'indice n'appartient pas a la sélection), lorsque j'enregistre mon classeur a l'aide d'un VBA

Voici le code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeletePopUpMenu
End Sub

Private Sub Workbook_Open()
CreateDisplayPopUpMenu
End Sub

'******************************************************************************
'Procedure permettant de sauvegarder au format Excel Un Formulaire
'dans le dossier actif ayant pour nom la valeur d'une cellule
'******************************************************************************

Sub Archivage()

'Décalration des variables
Dim NomDossier As String
Dim CheminDossier As String

'Gestion des erreurs
Application.DisplayAlerts = False 'On désactive les messages d'alerte
If Range("A3").Value = "" Then 'On teste que le nom du fichier a bien été saisi ou pas
MsgBox "*** Atention *** Vous n'avez pas saisi"
Range("A3").Select
Else ' SINON
Nom = ThisWorkbook.Path & "\" & Range("A3") & UCase(Format([B1], " DD MMMM YYYY"))
flag = 0
chemin = ThisWorkbook.Path & "\"
nom1C = Range("A3") & UCase(Format([B1], " DD MMMM YYYY")) & ".xlsm"
nomFichier = Dir(chemin & "*.xls*")
Do While Len(nomFichier) > 0
If nomFichier = nom1C Then
flag = 1
If flag = 1 Then
rep = InputBox("" & nom1C & " Existe Déjà." & Chr(13) & Chr(13) & "Changez Pour :", nom1C, nom1C)
Exit Sub
End If
End If
nomFichier = Dir
Loop
With ActiveWorkbook 'Enregistrement du classeur portant le nom de la cellule A3
.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("A3") & " " & UCase(Format([B1], "DD MMMM YYYY")), FileFormat:=xlOpenXMLWorkbookMacroEnabled
End With
'On affiche un message informant que le fichier a bien été sauvegardé.
MsgBox "Votre Formulaire Au Nom De *** " & Range("A3") & " " & UCase(Format([B1], "DD MMMM YYYY")) & " *** A Bien Été Enregistré Dans Votre Dossier"
Sheets("Fiche Renseignement").Shapes("Bouton").Delete
End If
Application.DisplayAlerts = True 'On réactive la gestion des alertes.
End Sub


Merci de bien vouloir m'aider

Merci a tous

1 réponse

Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 361
Bonjour,

Il y a une ligne de code surlignee ou pas ??
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 361
Bonjour,

Ok, pas de ligne en surbrillance..
Pouvez mettre le fichier a dispo
Messages postés
113
Date d'inscription
vendredi 19 janvier 2018
Statut
Membre
Dernière intervention
16 février 2020

Bonjour

Trop de données personnelles dans ce fichier

puis-je en privé ?

Merci
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 361
Re,

Prive, oui
Messages postés
113
Date d'inscription
vendredi 19 janvier 2018
Statut
Membre
Dernière intervention
16 février 2020

Message envoyé

Merci
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 361
Re,
Ai vu et je regarde la chose