Erreur 1004 classeur partagé

Le 21/03/2023 à 16:15

bonjour à tous,

le code ci dessous fonctionne tres bien quand mon classeur est en utilisation exclusive.

en revanche des je met le classeur en partagé ça bug systematiquement.

en plus impossible d'utiliser le debogueur pour savoir sur quelle ligne est le souci...

si quelqu'un peut m'aider... merci d'avance

Sub maj_liste_deroulante()
'
' recupere les ref des prog pour ensuite creer menu deroulant

Sheets("listederoulante").Visible = True
Workbooks.Open "M:\MAG OUTIL\AA  27-03-02\PALETISE\1ERE BASE POUR CAS EMPLOI.xlsm"
Sheets("DATA").Visible = True 'le fichier a ouvrir si contenu dans un autre classeur, sinon pas utile'

Sheets("DATA").Select

    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Windows("2 ok SUIVI PLOTS.xlsm").Activate
    Sheets("listederoulante").Select

    Range("B2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("B:B").Select

    ActiveSheet.Range("$B$1:$B$90000").RemoveDuplicates Columns:=1, Header:= _
        xlNo

        Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Names.Add Name:="ref_prog", RefersToR1C1:= _
        "=listederoulante!R1C2:R5555C2"

   Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("listederoulante").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("listederoulante").Sort.SortFields.Add Key:=Range( _
        "B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("listederoulante").Sort
        .SetRange Range("B3:B4058")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D2").Select

  Workbooks("1ERE BASE POUR CAS EMPLOI.xlsm").Close SaveChanges:=False

    Range("P10:P18").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=ref_prog"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
          .ShowInput = True
        .ShowError = True
    End With
    Range("P22").Select
Sheets("listederoulante").Visible = False
End Sub
Le 21/03/2023 à 16:35

Bonjour,

Pour moi, vite fait sans trop chercher, je mise sur :

Workbooks.Open "M:\MAG OUTIL\AA  27-03-02\PALETISE\1ERE BASE POUR CAS EMPLOI.xlsm"

Cette partie pas accessible a tous ?

Le 21/03/2023 à 17:02

Bonjour,

Vérifiez que votre classeur ne comporte pas de tableau structuré car ce n'est pas compatible avec le partage classique.

Le 22/03/2023 à 09:00

Geof52 : non ce fichier est une base de données non accessible a tous.

Le 22/03/2023 à 09:14

Bonjour Slygan, le fil

Et bien alors ne cherchez plus

@Geof52 vous a indiqué ou se situe le problème

Ceci dit, définissez des variables et travaillez comme il se doit avec les objets et non à grand renfort de "Select" 

Sub MaJ_Liste_Deroulante()
  Dim Wbk As Workbook, ShtS As Worksheet
  Dim ShtLd As Worksheet
  Dim dLig As Long
  '
  ' recupere les ref des prog pour ensuite creer menu deroulant
  Set ShtLd = ThisWorkbook.Sheets("listederoulante")
  '
  Set Wbk = Workbooks.Open("M:\MAG OUTIL\AA  27-03-02\PALETISE\1ERE BASE POUR CAS EMPLOI.xlsm")
  Set ShtS = Wbk.Sheets("DATA")
  '
  ShtS.Visible = xlSheetVisible
  dLig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ShtS.Range("A2:A" & dLig).Copy
  '
  ShtLd.Range("B2").PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  dLig = ShtLd.Range("B" & Rows.Count).End(xlUp).Row
  ShtLd.Range("$B$1:$B$" & dLig).RemoveDuplicates Columns:=1, Header:=xlNo
  dLig = ShtLd.Range("B" & Rows.Count).End(xlUp).Row
  ThisWorkbook.Names.Add Name:="ref_prog", RefersToR1C1:="=listederoulante!R1C2:R" & dLig & "C2"
  With ShtLd.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                      DataOption:=xlSortNormal
      .SetRange Range("B3:B" & dLig)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  Wbk.Close SaveChanges:=False
  With ActiveSheet.Range("P10:P18")
      With .Validation
          .Delete
          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
               xlBetween, Formula1:="=ref_prog"
          .IgnoreBlank = True
          .InCellDropdown = True
          .InputTitle = ""
          .ErrorTitle = ""
          .InputMessage = ""
          .ErrorMessage = ""
          .ShowInput = True
          .ShowError = True
      End With
  End With
  ShtLd.Visible = xlSheetHidden
  ' Effacer les variables objet
  Set ShtLd = Nothing: Set ShtS = Nothing: Set Wbk = Nothing
End Sub

A+

Le 22/03/2023 à 16:51

bonjour a tous ,

BrunoM45 , désolé pour les SELECT mais n'étant pas un pro je me sert de l'enregistreur de macro...

ton code ne fonctionne pas vraiment comme j'en ai besoin et ma méconnaissance m'empêche de te dire où est le problème.

A la base c'est vraiment le problème du bug quand le fichier est partagé que je voudrais résoudre.

Geof52 : je ne vois pas ou tu veut en venir avec le bout de code que tu m'a indiqué...

Le 22/03/2023 à 17:04

Re,

Le code ainsi modifié devrait te permettre de ne plus avoir cette erreur 1004,

lorsqu'on a un bug une fenêtre de débogage s'affiche, il suffit de cliquer sur le bouton "Débogage"
VBAProject s'ouvre et affiche en surlignée, la ligne fautive de cette erreur

Il suffit de nous faire un Screenpresso de cette ligne pour que l'on en sache d'avantage

Sinon tu peux aussi faire du pas à pas, pour ça, il faut se positionner sur la ligne "Set ShtLd ..."
Appuyer sur [F9]
Ensuite tu lances ton code, et tu fais [F8] pour avancer et vérifier ce qui se passe dans le classeur

A+

Le 22/03/2023 à 17:08

Bonjour,

Ce n'est pas un code que j'ai donné mais identifier un soucis dans ton code puisque le fichier a ouvrir,

Geof52 : non ce fichier est une base de données non accessible a tous.

n'est pas disponible pour les utilisateurs alors comment la macro pourrait l'ouvrir ?

Le 23/03/2023 à 08:36

BrunoM45 , quand un classeur est partagé on a pas accès au débogueur ou même au menu développeur (tout est grisé) et donc impossible de faire du pas a pas ...

Le 23/03/2023 à 08:48

Slygan,

quand un classeur est partagé on a pas accès au débogueur ou même au menu développeur (tout est grisé) et donc impossible de faire du pas a pas ...

Je le sais parfaitement

en revanche des je met le classeur en partagé ça bug systematiquement.

Ce que j'ai compris, lorsque que le classeur est partagé, il bug lorsqu'il est utilisé par une tiers personne.

Ou j'ai mal compris et il bug sur votre poste !?

A+

Le 23/03/2023 à 10:55

BrunoM45, ça bug sur mon poste. pour le moment il n'y a que moi qui utilise ce fichier.

je suis en train de le mettre au point avant de le partager réellement

c'est en faisant des essais en mode partagé que j'ai constaté le bug.

des que j'enlève le partage tout re fonctionne bien à nouveau.

Le 23/03/2023 à 14:01

Ok en recréant un pseudo fichier, chose que nous ne devrions pas avoir à faire

J'ai effectivement 2 erreurs, voici le code pour test

Sub MaJ_Liste_Deroulante()
  Dim Wbk As Workbook, ShtS As Worksheet
  Dim ShtLd As Worksheet
  Dim dLig As Long
  '
  ' recupere les ref des prog pour ensuite creer menu deroulant
  Set ShtLd = ThisWorkbook.Sheets("listederoulante")
  '
  'Set Wbk = Workbooks.Open("M:\MAG OUTIL\AA  27-03-02\PALETISE\1ERE BASE POUR CAS EMPLOI.xlsm")
  'Set ShtS = Wbk.Sheets("DATA")
  Set Wbk = Workbooks.Open("T:\AFFAIRES\PlanniF'IRC\BdDExcel\BdD Moyens.xlsx")
  Set ShtS = Wbk.Sheets("MATERIEL")
  ' Afficher les feuilles
  ShtS.Visible = xlSheetVisible
  ShtLd.Visible = xlSheetVisible
  ' Copie les données
  dLig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ShtS.Range("A2:A" & dLig).Copy
  ' Les coller
  ShtLd.Range("B2").PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  ' Fermer le classeur source
  Wbk.Close SaveChanges:=False
  '
  MsgBox "Supprimer les doublons"
  On Error Resume Next
  dLig = ShtLd.Range("B" & Rows.Count).End(xlUp).Row
  ShtLd.Range("$B$1:$B$" & dLig).RemoveDuplicates Columns:=1, Header:=xlYes
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "Erreur, suite : Ajout des noms"
  Else
    MsgBox "Ajout des noms"
  End If
  dLig = ShtLd.Range("B" & Rows.Count).End(xlUp).Row
  ThisWorkbook.Names.Add Name:="ref_prog", RefersToR1C1:="=listederoulante!R2C2:R" & dLig & "C2"
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "Erreur, suite : Tri de slignes"
  Else
    MsgBox "Tri des lignes"
  End If
  With ShtLd.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                      DataOption:=xlSortNormal
      .SetRange Range("B2:B" & dLig)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "Erreur, suite : MFC"
  Else
    MsgBox "MFC"
  End If
  With Sheets(1).Range("P10:P18")
      With .Validation
          .Delete
          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
               xlBetween, Formula1:="=ref_prog"
          .IgnoreBlank = True
          .InCellDropdown = True
          .InputTitle = ""
          .ErrorTitle = ""
          .InputMessage = ""
          .ErrorMessage = ""
          .ShowInput = True
          .ShowError = True
      End With
  End With
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "Erreur - Fin !"
  Else
    MsgBox "Fin"
  End If
  On Error GoTo 0
  ShtLd.Visible = xlSheetHidden
  ' Effacer les variables objet
  Set ShtLd = Nothing: Set ShtS = Nothing: Set Wbk = Nothing
End Sub

Problème pour la suppression des doublons et pour la MFC, ce qui après réflexion n'est pas incohérent

Seule solution désactiver le partage temporairement et le remettre

A+

Le 24/03/2023 à 09:57

BrunoM45,

effectivement, probleme avec les doublons quand le classeur est partagé.

en exclusif ca marche nickel.

est il possible , en debut de code , de nous sortir du mode partagé et y retourner à la fin ...?

Le 24/03/2023 à 09:58

le souci c'est la sauvegarde automatique que cela engendre... possible de l'éviter ??

Rechercher des sujets similaires à "erreur 1004 classeur partage"