L'Indice n'appartient pas .....

Messages postés
93
Date d'inscription
vendredi 19 janvier 2018
Statut
Membre
Dernière intervention
6 septembre 2019
- - Dernière réponse : f894009
Messages postés
14715
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 septembre 2019
- 6 sept. 2019 à 11:20
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
Afficher la suite 

1 réponse

Messages postés
14715
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 septembre 2019
1171
0
Merci
Bonjour,

Il y a une ligne de code surlignee ou pas ??
f894009
Messages postés
14715
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 septembre 2019
1171 -
Bonjour,

Ok, pas de ligne en surbrillance..
Pouvez mettre le fichier a dispo
faisdlair
Messages postés
93
Date d'inscription
vendredi 19 janvier 2018
Statut
Membre
Dernière intervention
6 septembre 2019
-
Bonjour

Trop de données personnelles dans ce fichier

puis-je en privé ?

Merci
f894009
Messages postés
14715
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 septembre 2019
1171 -
Re,

Prive, oui
faisdlair
Messages postés
93
Date d'inscription
vendredi 19 janvier 2018
Statut
Membre
Dernière intervention
6 septembre 2019
-
Message envoyé

Merci
f894009
Messages postés
14715
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 septembre 2019
1171 -
Re,
Ai vu et je regarde la chose
Commenter la réponse de f894009