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...

patricktoulon

XLDnaute Barbatruc
bonsoir
1° un range nommé n'apas besoins d'être préfixé par son parent
with range("nom") et c'est tout
sinon si tu n'est pas sur la feuille ca va demander plus de memoire et au bout d'un moment tu a des erreurs invraissemblables
2° abs sur un string renvoie un numeric
3° un abs sur un etat (true,false )renvoie un numeric
sur certaines version et system notament 2021 sur W11 au boulot
j'ai observé un problème avec les etats
en effet au lieu de mettre
=array(abs(truc),abs(machin),etc...)
il faut mettre
=array(abs(truc.value=true)(abs(machin.value=true),etc....)

je sais c'es biledé mais bon perso je m'en suis sorti comme ça
;)
 

eric72

XLDnaute Accro
bonsoir
1° un range nommé n'apas besoins d'être préfixé par son parent
with range("nom") et c'est tout
sinon si tu n'est pas sur la feuille ca va demander plus de memoire et au bout d'un moment tu a des erreurs invraissemblables
2° abs sur un string renvoie un numeric
3° un abs sur un etat (true,false )renvoie un numeric
sur certaines version et system notament 2021 sur W11 au boulot
j'ai observé un problème avec les etats
en effet au lieu de mettre
=array(abs(truc),abs(machin),etc...)
il faut mettre
=array(abs(truc.value=true)(abs(machin.value=true),etc....)

je sais c'es biledé mais bon perso je m'en suis sorti comme ça
;)
Bonsoir Patrick,
1 j'ai ajouté le nom de la feuille pour essayer, je vais donc l'enlever
2 je vais essayer abs(truc.value=true)
je teste tout ça pour voir
Merci beaucoup
 

eric72

XLDnaute Accro
bonsoir
1° un range nommé n'apas besoins d'être préfixé par son parent
with range("nom") et c'est tout
sinon si tu n'est pas sur la feuille ca va demander plus de memoire et au bout d'un moment tu a des erreurs invraissemblables
2° abs sur un string renvoie un numeric
3° un abs sur un etat (true,false )renvoie un numeric
sur certaines version et system notament 2021 sur W11 au boulot
j'ai observé un problème avec les etats
en effet au lieu de mettre
=array(abs(truc),abs(machin),etc...)
il faut mettre
=array(abs(truc.value=true)(abs(machin.value=true),etc....)

je sais c'es biledé mais bon perso je m'en suis sorti comme ça
;)
Voilà comment j'ai modifié le code mais malheureusement rien n'y fait:
VB:
With Range("TbId").ListObject

            .ListRows.Add.Range.Value = Array(TxtInit.Text, TxtMdp.Text, Abs(ChbEffectif.Value = True), Abs(ChbAbsence.Value = True), Abs(ChbSemType.Value = True), Abs(ChbAmplitude.Value = True), Abs(ChbNbparTranche.Value = True), Abs(ChbPosteService.Value = True), _
             Abs(ChbCptHres.Value = True), Abs(ChbPoste.Value = True), Abs(ChbService.Value = True), Abs(ChbJrOuv.Value = True), Abs(ChbPlanning.Value = True), Abs(ChbSoldeCompteurhr.Value = True), Abs(ChbPersPres.Value = True), Abs(ChbPrepaSalaire.Value = True)) '
End With
Snifff!!!
 

patricktoulon

XLDnaute Barbatruc
a tu essayé comme ça
VB:
With Range("TbId").ListObject.ListRows.Add.Range
.Value = Array(TxtInit.Text, TxtMdp.Text, Abs(ChbEffectif.Value = True), Abs(ChbAbsence.Value = True), Abs(ChbSemType.Value = True), Abs(ChbAmplitude.Value = True), Abs(ChbNbparTranche.Value = True), Abs(ChbPosteService.Value = True), _
             Abs(ChbCptHres.Value = True), Abs(ChbPoste.Value = True), Abs(ChbService.Value = True), Abs(ChbJrOuv.Value = True), Abs(ChbPlanning.Value = True), Abs(ChbSoldeCompteurhr.Value = True), Abs(ChbPersPres.Value = True), Abs(ChbPrepaSalaire.Value = True)) '
End With
 

eric72

XLDnaute Accro
a tu essayé comme ça
VB:
With Range("TbId").ListObject.ListRows.Add.Range
.Value = Array(TxtInit.Text, TxtMdp.Text, Abs(ChbEffectif.Value = True), Abs(ChbAbsence.Value = True), Abs(ChbSemType.Value = True), Abs(ChbAmplitude.Value = True), Abs(ChbNbparTranche.Value = True), Abs(ChbPosteService.Value = True), _
             Abs(ChbCptHres.Value = True), Abs(ChbPoste.Value = True), Abs(ChbService.Value = True), Abs(ChbJrOuv.Value = True), Abs(ChbPlanning.Value = True), Abs(ChbSoldeCompteurhr.Value = True), Abs(ChbPersPres.Value = True), Abs(ChbPrepaSalaire.Value = True)) '
End With
Je viens d'essayer et j'ai juste eu le temps de voir que le bug était sur listrows.add.range

VB:
With Range("TbId").ListObject.ListRows.Add.Range

ce qui voudrait dire que ce ne sont pas les données qui sont en cause?
 

fanch55

XLDnaute Barbatruc
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 ....
 

Statistiques des forums

Discussions
314 628
Messages
2 111 336
Membres
111 104
dernier inscrit
JEMADA