Microsoft 365 add.range plante Excel

eric72

XLDnaute Accro
Bonjour à tous,
je rencontre un problème pour ajouter une ligne à un tableau à partir de Userform avec ce code:
VB:
With Sheets("Id").Range("TbId").ListObject
            .ListRows.Add.Range.Value = Array(TxtInit, TxtMdp, Abs(ChbEffectif), Abs(ChbAbsence), Abs(ChbSemType), Abs(ChbAmplitude), Abs(ChbNbparTranche), Abs(ChbPosteService), _
             Abs(ChbCptHres), Abs(ChbPoste), Abs(ChbService), Abs(ChbJrOuv), Abs(ChbPlanning), Abs(ChbSoldeCompteurhr), Abs(ChbPersPres), Abs(ChbPrepaSalaire))
la macro échoue de manière aléatoire et en plus Excel se ferme tout seul, ç'est pourtant une méthode relativement simple et pourtant!!!
Avez-vous une idée du pourquoi?
Merci beaucoup pour votre aide
Eric
 

Pièces jointes

  • Planning EDL.xlsm
    345.6 KB · Affichages: 8
Solution
Et là j'i eu une lumière (si,si ça peut arriver!!!), à l'ouverture de mon fichier j'ai un Usf d'identification avec mot de passe avec le code suivant:
VB:
Private Sub BtValider_Click()
Dim tableau As Range
Dim MDP As String
Dim ID As Variant
Set tableau = ThisWorkbook.Worksheets("Id").ListObjects("TbId").DataBodyRange
ID = Application.Match(CbNom, Range("Tbid[Utilisateur]"), 0)
If CbNom = "" Then MsgBox "Vous devez saisir un nom d'utilisateur": Exit Sub
If TxtMdp = "" Then MsgBox "Vous devez saisir un Mot de Passe": Exit Sub
    MDP = WorksheetFunction.VLookup(CbNom, tableau, 2, False)
    
    If IsError(MDP) Then MsgBox "Mot de Passe inconnu": TxtMdp = "": Exit Sub
    If MDP <> TxtMdp Then MsgBox "Mot de Passe inconnu": TxtMdp = "": Exit Sub...

eric72

XLDnaute Accro
Modif du code existant Pour dépanner :
VB:
Private Sub BtnValider_Click()
Dim X&, I&
Dim NbrRotation As Byte

 DateDebut = IIf(TxtDateRotation.Value = "", 0, TxtDateRotation.Value)
 datenaissance = IIf(TxtDateNaissance.Value = "", 0, TxtDateNaissance.Value)
 DatedebutFixe = IIf(TxtDateFixe.Value = "", 0, TxtDateFixe.Value)
 NbSemRot = IIf(CbNbSemRotation.Value = "", 0, CbNbSemRotation.Value)
    'If TxtDateRotation = "" And ObRotation = True Then MsgBox "Vous devez Sélectionner une date de début ": Exit Sub
    'If TxtDateNaissance = "" Then MsgBox "Vous devez Indiquer une date de Naissance ": Exit Sub
    'If TxtMdp = "" Then MsgBox "Vous devez Saisir un mot de passe (ATTENTION AUX MAJUSCULES) ": Exit Sub
    'If TxtDateFixe = "" And ObFixe = True Then MsgBox "Vous devez Sélectionner une date de début ": Exit Sub
    'If ChbMajoration = True And TxtTaux = "" Then MsgBox "Vous devez saisir un taux de Majoration": TxtTaux.SetFocus: Exit Sub
    'If ObFixe.Value = False And ObRotation.Value = False Then MsgBox "Vous devez choisir si le planning est fixe ou tournant": Exit Sub
    'If ObFixe.Value = True And CbSemTypeFixe = "" Then MsgBox "Vous avez choisi un Planning fixe, vous devez sélectionner la Semaine Type attribuée": CbSemTypeFixe.SetFocus: Exit Sub
    'If ObRotation.Value = True And CbNbSemRotation.Value = "" Then MsgBox "Vous avez choisi un Planning à rotation, vous devez sélectionner le nombre de semaines de rotation": CbNbSemRotation.SetFocus: Exit Sub

'    For I = 1 To NbrRotation
'        If Me.Controls("CbSemType" & I).Text = Empty Then MsgBox "Vous devez sélectionner " & NbrRotation & " Semaines type": Exit Sub
''    Next
' Modif pour tracer les variables à mettre dans la table TbId --------------------------------------------------------------
    A = Split("TxtInit,TxtMdp,ChbEffectif,ChbAbsence,ChbSemType,ChbAmplitude,ChbNbparTranche,ChbPosteService," & _
        "ChbCptHres,ChbPoste,ChbService,ChbJrOuv,ChbPlanning,ChbSoldeCompteurhr,ChbPersPres,ChbPrepaSalaire", ",")
    Dim Log
    If Not Dir(ThisWorkbook.Path & "\Journal.txt") = "" Then Kill ThisWorkbook.Path & "\Journal.txt"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For I = 0 To UBound(A)
        Set Log = FSO.OpenTextFile(ThisWorkbook.Path & "\Journal.txt", 8, True)
            Log.writeline Right(space(30) & [TbId].ListObject.ListColumns(I + 1), 30) & "=" & Me.Controls(A(I))
        Log.Close
    Next
' Fin de Modif --------------------------------------------------------------------------------------------------------------
    With Sheets("Id").Range("TbId").ListObject
            .ListRows.Add.Range.Value = Array(TxtInit, TxtMdp, Abs(ChbEffectif), Abs(ChbAbsence), Abs(ChbSemType), Abs(ChbAmplitude), Abs(ChbNbparTranche), Abs(ChbPosteService), _
             Abs(ChbCptHres), Abs(ChbPoste), Abs(ChbService), Abs(ChbJrOuv), Abs(ChbPlanning), Abs(ChbSoldeCompteurhr), Abs(ChbPersPres), Abs(ChbPrepaSalaire))
    End With

    With [TbEffectif].ListObject
            X = Application.IfError(Application.Match(TxtNom, .Range.Columns(1), 0), 0) And Application.IfError(Application.Match(TxtPrenom, .Range.Columns(2), 0), 0)
            If X <> 0 Then MsgBox "Ce Collaborateur existe déjà" & vbCrLf: Exit Sub ' Teste si n'existe pas déjà avec le nom et prénom
    End With
          
    With Range("TbEffectif").ListObject 'ajoute une ligne à TbEffectif
            .ListRows.Add.Range.Value = Array(TxtNom, TxtPrenom, CbPoste, CDate(datenaissance), CDbl(TxtNbHeure), ChbOui, TxtTaux, TxtInit, Abs(ObFixe), Abs(ObRotation), CDbl(NbSemRot), _
            CbSemTypeFixe, CbSemType1, CbSemType2, CbSemType3, CbSemType4, CbSemType5, CbSemType6, CDate(DateDebut), CDate(DatedebutFixe)) 'on ajoute une ligne au tableau
    End With
          

    If ObFixe = True Then
        ArchiverPlanningFixe
        xderligne
        Duplique_Planning
    ElseIf ObRotation = True Then
        ArchiverPlanningRotation
        xderligne
        Duplique_Planning
    End If
vidange
RemplitlesListes
End Sub
Quand ça plante, éditer le fichier Journal.txt dans le même dossier et regarder quelle est la dernière variable écrite ....
J'ai mis ce code mais ca beug ici

VB:
If Not Dir(ThisWorkbook.Path & "\Journal.txt") = "" Then

Merci
 

fanch55

XLDnaute Barbatruc
J'ai mis ce code mais ca beug ici

VB:
If Not Dir(ThisWorkbook.Path & "\Journal.txt") = "" Then

Merci
oki, j'ai remplacé le Dir qui yoyotte parfois avec M365

VB:
Private Sub BtnValider_Click()
Dim X&, I&
Dim NbrRotation As Byte

 DateDebut = IIf(TxtDateRotation.Value = "", 0, TxtDateRotation.Value)
 datenaissance = IIf(TxtDateNaissance.Value = "", 0, TxtDateNaissance.Value)
 DatedebutFixe = IIf(TxtDateFixe.Value = "", 0, TxtDateFixe.Value)
 NbSemRot = IIf(CbNbSemRotation.Value = "", 0, CbNbSemRotation.Value)
    'If TxtDateRotation = "" And ObRotation = True Then MsgBox "Vous devez Sélectionner une date de début ": Exit Sub
    'If TxtDateNaissance = "" Then MsgBox "Vous devez Indiquer une date de Naissance ": Exit Sub
    'If TxtMdp = "" Then MsgBox "Vous devez Saisir un mot de passe (ATTENTION AUX MAJUSCULES) ": Exit Sub
    'If TxtDateFixe = "" And ObFixe = True Then MsgBox "Vous devez Sélectionner une date de début ": Exit Sub
    'If ChbMajoration = True And TxtTaux = "" Then MsgBox "Vous devez saisir un taux de Majoration": TxtTaux.SetFocus: Exit Sub
    'If ObFixe.Value = False And ObRotation.Value = False Then MsgBox "Vous devez choisir si le planning est fixe ou tournant": Exit Sub
    'If ObFixe.Value = True And CbSemTypeFixe = "" Then MsgBox "Vous avez choisi un Planning fixe, vous devez sélectionner la Semaine Type attribuée": CbSemTypeFixe.SetFocus: Exit Sub
    'If ObRotation.Value = True And CbNbSemRotation.Value = "" Then MsgBox "Vous avez choisi un Planning à rotation, vous devez sélectionner le nombre de semaines de rotation": CbNbSemRotation.SetFocus: Exit Sub

'    For I = 1 To NbrRotation
'        If Me.Controls("CbSemType" & I).Text = Empty Then MsgBox "Vous devez sélectionner " & NbrRotation & " Semaines type": Exit Sub
''    Next
' Modif pour tracer les variables à mettre dans la table TbId --------------------------------------------------------------
    A = Split("TxtInit,TxtMdp,ChbEffectif,ChbAbsence,ChbSemType,ChbAmplitude,ChbNbparTranche,ChbPosteService," & _
        "ChbCptHres,ChbPoste,ChbService,ChbJrOuv,ChbPlanning,ChbSoldeCompteurhr,ChbPersPres,ChbPrepaSalaire", ",")
    Dim Log
    Logfile = ThisWorkbook.Path & "\Journal.txt"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(Logfile)  Then FSO.deletefile Logfile
    For I = 0 To UBound(A)
        Set Log = FSO.OpenTextFile(Logfile, 8, True)
            Log.writeline Right(Space(30) & [TbId].ListObject.ListColumns(I + 1), 30) & " = " & Me.Controls(A(I))
        Log.Close
    Next
' Fin de Modif --------------------------------------------------------------------------------------------------------------
    With Sheets("Id").Range("TbId").ListObject
            .ListRows.Add.Range.Value = Array(TxtInit, TxtMdp, Abs(ChbEffectif), Abs(ChbAbsence), Abs(ChbSemType), Abs(ChbAmplitude), Abs(ChbNbparTranche), Abs(ChbPosteService), _
             Abs(ChbCptHres), Abs(ChbPoste), Abs(ChbService), Abs(ChbJrOuv), Abs(ChbPlanning), Abs(ChbSoldeCompteurhr), Abs(ChbPersPres), Abs(ChbPrepaSalaire))
    End With

    With [TbEffectif].ListObject
            X = Application.IfError(Application.Match(TxtNom, .Range.Columns(1), 0), 0) And Application.IfError(Application.Match(TxtPrenom, .Range.Columns(2), 0), 0)
            If X <> 0 Then MsgBox "Ce Collaborateur existe déjà" & vbCrLf: Exit Sub ' Teste si n'existe pas déjà avec le nom et prénom
    End With
           
    With Range("TbEffectif").ListObject 'ajoute une ligne à TbEffectif
            .ListRows.Add.Range.Value = Array(TxtNom, TxtPrenom, CbPoste, CDate(datenaissance), CDbl(TxtNbHeure), ChbOui, TxtTaux, TxtInit, Abs(ObFixe), Abs(ObRotation), CDbl(NbSemRot), _
            CbSemTypeFixe, CbSemType1, CbSemType2, CbSemType3, CbSemType4, CbSemType5, CbSemType6, CDate(DateDebut), CDate(DatedebutFixe)) 'on ajoute une ligne au tableau
    End With
           

    If ObFixe = True Then
        ArchiverPlanningFixe
        xderligne
        Duplique_Planning
    ElseIf ObRotation = True Then
        ArchiverPlanningRotation
        xderligne
        Duplique_Planning
    End If
vidange
RemplitlesListes
End Sub
 

eric72

XLDnaute Accro
Bonjour à tous,
Après une bonne nuit de réflexion
j'ai testé un truc tout bête ce matin, dans ma feuille ou se trouve mon tableau, j'essaie de saisir une valeur dans la 1ere ligne vide sous mon tableau, normalement cela devrait redimensionner mon tableau et là ça beug, comme si la dimension du tableau était verrouillée, excel ne répond pas et ça mouline tant que je ne force pas la fermeture, comme si une macro était en cours, grand mystère...
 

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Après une bonne nuit de réflexion
j'ai testé un truc tout bête ce matin, dans ma feuille ou se trouve mon tableau, j'essaie de saisir une valeur dans la 1ere ligne vide sous mon tableau, normalement cela devrait redimensionner mon tableau et là ça beug, comme si la dimension du tableau était verrouillée, excel ne répond pas et ça mouline tant que je ne force pas la fermeture, comme si une macro était en cours, grand mystère...
Saisir dans la première ligne vide sous le tableau n’agrandit pas celui-ci ...
 

eric72

XLDnaute Accro
Et là j'i eu une lumière (si,si ça peut arriver!!!), à l'ouverture de mon fichier j'ai un Usf d'identification avec mot de passe avec le code suivant:
VB:
Private Sub BtValider_Click()
Dim tableau As Range
Dim MDP As String
Dim ID As Variant
Set tableau = ThisWorkbook.Worksheets("Id").ListObjects("TbId").DataBodyRange
ID = Application.Match(CbNom, Range("Tbid[Utilisateur]"), 0)
If CbNom = "" Then MsgBox "Vous devez saisir un nom d'utilisateur": Exit Sub
If TxtMdp = "" Then MsgBox "Vous devez saisir un Mot de Passe": Exit Sub
    MDP = WorksheetFunction.VLookup(CbNom, tableau, 2, False)
    
    If IsError(MDP) Then MsgBox "Mot de Passe inconnu": TxtMdp = "": Exit Sub
    If MDP <> TxtMdp Then MsgBox "Mot de Passe inconnu": TxtMdp = "": Exit Sub
        If MDP = TxtMdp Then
    voirbutton CbNom
 End If
[B][COLOR=rgb(247, 218, 100)][U]Me.Hide[/U][/COLOR][/B]
Sheets("Données").Range("ge2") = Abs(Tb2Ecrans)
End Sub

j'ai donc remplacé Me.Hide par Unload me et j'ai l'impression que le beug venait de là...
 

TooFatBoy

XLDnaute Barbatruc
C'est normal, tu as un pb de syntaxe dans ton à ce niveau là :
VB:
[B][COLOR=rgb(247, 218, 100)][U]Me.Hide[/U][/COLOR][/B]

Nan, j'rigole. Il faut utiliser le paramètre rich et non vb si tu veux faire de la mise en forme de code sur le forum :
Enrichi (BBcode):
Me.Hide
 

Statistiques des forums

Discussions
312 220
Messages
2 086 376
Membres
103 198
dernier inscrit
CACCIATORE