Bonjour, j'ai crée cette macro et une erreur apparait : erreur d'execution 1004 LA METHODE SELECT A ECHOUEE
La partie de ma macro en gras, ne fonctionne que lorsque la feuille Tout n'est pas masquée. Or j'ai besoin que cette feuille soit actualisée lorsque la macro est lancée et qu'elle soit masquée.
Savez vous d'où vient le problème ?
'Ajouter des lignes dans les plan daction des départements
Sub AjouterAction()
'Accélération du code VBA (arret du rafraichissement de l'écran)
With Application
.StatusBar = "Imporation et calculs"
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Declare les variables
Dim oSheetName As Worksheet
Dim loTable As ListObject
Dim lrRow As ListRow
Dim sSheetNameIn As String
Dim sSheetNameList As String
Dim sSheetNameOut As String
Dim sTableNameOut As String
Dim rngDepList As Range
Dim rngDepListExclusion As Range
Dim vDepList() As Variant
Dim vDepName As Variant
Dim IsExluded As Boolean
'Paramétres
sSheetNameIn = "Saisie" 'Nom de la feuille de saisie
sSheetNameList = "_Liste" 'Nom de la feuille contenant les listes
'Variables
Set oSheetNameIn = Sheets(sSheetNameIn) 'Feuille de saisie
Set oSheetNameList = Sheets(sSheetNameList) 'Feuille des listes
Set rngDepList = oSheetNameList.Range("Ls_département") 'Liste des départements
Set rngDepListExclusion = oSheetNameList.Range("Ls_depexclu") 'Liste de département à exclure
'Tout les champs sont complétés
If oSheetNameIn.Range("F_ajouter") Then
'Liste des table à compléter
If oSheetNameIn.Range("F_département") = "DIT" Then 'Toute les tables
vDepList = rngDepList
Else
vDepList = Array(oSheetNameIn.Range("F_département")) 'Seulement la table du département selectionnée
End If
For Each vDepName In vDepList
'Verifie que le département nest pas dans la liste dexclusion
If oSheetNameIn.Range("F_département") = "DIT" Then
Dim element As Variant
IsExluded = False
For Each element In rngDepListExclusion
If vDepName = element Then
IsExluded = True
End If
Next element
Else
IsExluded = False
End If
'Sil nest pas exlcut
If (Not IsExluded) Then
'Variables qui dépendent du département selectionné
sSheetNameOut = vDepName 'Nom de la feuille ou se situe la table à compléter
Set oSheetNameOut = Sheets(sSheetNameOut) 'Feuille qui contient la table à compléter
sTableNameOut = "PA_" & vDepName 'Nom de la table à compléter
Set loTableOut = oSheetNameOut.ListObjects(sTableNameOut) 'Table à compléter
Set lrRow = loTableOut.ListRows.Add 'Action ajouter une ligne
'Ajout des lignes
With lrRow
.Range(1) = oSheetNameIn.Range("F_codification1") & oSheetNameIn.Range("F_codification2") 'Codification
.Range(2) = oSheetNameIn.Range("F_origine") 'Origine
.Range(3) = oSheetNameIn.Range("F_sujet") 'Sujet
.Range(4) = oSheetNameIn.Range("F_description") 'Description
.Range(5) = oSheetNameIn.Range("F_initiateur") 'Initiateur
.Range(6) = oSheetNameIn.Range("F_responsable") 'Responsable
.Range(7) = oSheetNameIn.Range("F_priorité") 'Priorité
.Range(8) = "En cours" 'Statut
.Range(9) = oSheetNameIn.Range("F_datecréation") 'Date création
.Range(10) = oSheetNameIn.Range("F_dateobjectif") 'Date objectif
'.Range(11) 'Date cloture
'.Range(12) 'Jours restant
.Range(13) = vDepName 'Département
End With
'Tri les colonnes
With oSheetNameOut.ListObjects(sTableNameOut).Sort
.SortFields.Clear
.Header = xlYes
.SortFields.Add Key:=Range(sTableNameOut & "[[#All],
La partie de ma macro en gras, ne fonctionne que lorsque la feuille Tout n'est pas masquée. Or j'ai besoin que cette feuille soit actualisée lorsque la macro est lancée et qu'elle soit masquée.
Savez vous d'où vient le problème ?
'Ajouter des lignes dans les plan daction des départements
Sub AjouterAction()
'Accélération du code VBA (arret du rafraichissement de l'écran)
With Application
.StatusBar = "Imporation et calculs"
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Declare les variables
Dim oSheetName As Worksheet
Dim loTable As ListObject
Dim lrRow As ListRow
Dim sSheetNameIn As String
Dim sSheetNameList As String
Dim sSheetNameOut As String
Dim sTableNameOut As String
Dim rngDepList As Range
Dim rngDepListExclusion As Range
Dim vDepList() As Variant
Dim vDepName As Variant
Dim IsExluded As Boolean
'Paramétres
sSheetNameIn = "Saisie" 'Nom de la feuille de saisie
sSheetNameList = "_Liste" 'Nom de la feuille contenant les listes
'Variables
Set oSheetNameIn = Sheets(sSheetNameIn) 'Feuille de saisie
Set oSheetNameList = Sheets(sSheetNameList) 'Feuille des listes
Set rngDepList = oSheetNameList.Range("Ls_département") 'Liste des départements
Set rngDepListExclusion = oSheetNameList.Range("Ls_depexclu") 'Liste de département à exclure
'Tout les champs sont complétés
If oSheetNameIn.Range("F_ajouter") Then
'Liste des table à compléter
If oSheetNameIn.Range("F_département") = "DIT" Then 'Toute les tables
vDepList = rngDepList
Else
vDepList = Array(oSheetNameIn.Range("F_département")) 'Seulement la table du département selectionnée
End If
For Each vDepName In vDepList
'Verifie que le département nest pas dans la liste dexclusion
If oSheetNameIn.Range("F_département") = "DIT" Then
Dim element As Variant
IsExluded = False
For Each element In rngDepListExclusion
If vDepName = element Then
IsExluded = True
End If
Next element
Else
IsExluded = False
End If
'Sil nest pas exlcut
If (Not IsExluded) Then
'Variables qui dépendent du département selectionné
sSheetNameOut = vDepName 'Nom de la feuille ou se situe la table à compléter
Set oSheetNameOut = Sheets(sSheetNameOut) 'Feuille qui contient la table à compléter
sTableNameOut = "PA_" & vDepName 'Nom de la table à compléter
Set loTableOut = oSheetNameOut.ListObjects(sTableNameOut) 'Table à compléter
Set lrRow = loTableOut.ListRows.Add 'Action ajouter une ligne
'Ajout des lignes
With lrRow
.Range(1) = oSheetNameIn.Range("F_codification1") & oSheetNameIn.Range("F_codification2") 'Codification
.Range(2) = oSheetNameIn.Range("F_origine") 'Origine
.Range(3) = oSheetNameIn.Range("F_sujet") 'Sujet
.Range(4) = oSheetNameIn.Range("F_description") 'Description
.Range(5) = oSheetNameIn.Range("F_initiateur") 'Initiateur
.Range(6) = oSheetNameIn.Range("F_responsable") 'Responsable
.Range(7) = oSheetNameIn.Range("F_priorité") 'Priorité
.Range(8) = "En cours" 'Statut
.Range(9) = oSheetNameIn.Range("F_datecréation") 'Date création
.Range(10) = oSheetNameIn.Range("F_dateobjectif") 'Date objectif
'.Range(11) 'Date cloture
'.Range(12) 'Jours restant
.Range(13) = vDepName 'Département
End With
'Tri les colonnes
With oSheetNameOut.ListObjects(sTableNameOut).Sort
.SortFields.Clear
.Header = xlYes
.SortFields.Add Key:=Range(sTableNameOut & "[[#All],
Code:
]"), SortOn:=xlSortOnValues, Order:=xlDescending
.Apply
End With
With oSheetNameOut.ListObjects(sTableNameOut).Sort
.SortFields.Clear
.Header = xlYes
.SortFields.Add Key:=Range(sTableNameOut & "[[#All],[Statut]]"), SortOn:=xlSortOnValues, Order:=xlAscending
.Apply
End With
End If
Next vDepName
'Efface les saisies
oSheetNameIn.Range("F_origine").Value = vbNullString
oSheetNameIn.Range("F_sujet").Value = vbNullString
oSheetNameIn.Range("F_description").Value = vbNullString
oSheetNameIn.Range("F_initiateur").Value = vbNullString
oSheetNameIn.Range("F_responsable").Value = vbNullString
oSheetNameIn.Range("F_priorité").Value = vbNullString
oSheetNameIn.Range("F_dateobjectif").Value = vbNullString
oSheetNameIn.Range("F_département").Value = vbNullString
End If
'Accélération du code VBA (activation du rafraichissement de l'écran)
With Application
.StatusBar = ""
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
[B]' Actualise tout
Sheets("_Tout").Select
ActiveWorkbook.RefreshAll[/B]
End Sub
Bien cordialement