Probleme de rangement avec VBA

Résolu
hamzy Messages postés 17 Statut Membre -  
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour la communauté,

J'ai un petit soucis sur VBA.
j'ai un userform avec un bouton validation contenant une macro qui permet de ranger les valeurs des texbox dans une feuille de calcul excel ligne par ligne.
les champs sont les suivants:
nom prenom motif absence destination mission

1ere saisie: le champ destination mission n'est pas renseigné par l'utilisateur et après un click sur le bouton validation, les valeurs sont rangées sur la première ligne de la feuille sans la valeur du champ destination mission (Tout à fait normal).
2eme saisie: le champ destination mission est renseigné par l'utilisateur et après validation, les valeurs Nom, Prenom, Motif Absence sont rangées sur la 2e ligne qui suit (normal) et la valeur du champ "destination mission" est rangée dans la cellule vide correspondant à la 1ère ligne.

Comment faire en sorte que la valeur du champ "destination mission" soit rangée sur la 2e ligne comme les autres et non dans la 1ere cellule vide du 1er enregistrement.
Voici le code que j'utilise:
Sheets("BD").Range("A65536").End(xlUp).Offset(1, 0).Value = Nom.Value
Sheets("BD").Range("b65536").End(xlUp).Offset(1, 0).Value = Prenom.Value
Sheets("BD").Range("c65536").End(xlUp).Offset(1, 0).Value = Motifabsence.Value
Sheets("BD").Range("d65536").End(xlUp).Offset(1, 0).Value = destinationmission.Value

Merci de m'aider SVP.
Configuration: Windows 2003 Internet Explorer 7.0

12 réponses

  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Salut,
    Déjà eu le cas. Il faut stocker le numéro de la ligne concerné dans une variable, pour ensuite l'utiliser sur toutes tes valeurs à "ranger" :
    Dim numligne as Integer
    numligne = Range("A65536").End(xlUp).Offset(1, 0).Row
    Sheets("BD").Range("A" & numligne).Value = Nom.Value
    Sheets("BD").Range("B" & numligne).Value = Prenom.Value
    Sheets("BD").Range("C" & numligne).Value = Motifabsence.Value
    Sheets("BD").Range("D" & numligne).Value = destinationmission.Value

    Voilà n'hésite pas si cela ne te sied guère
    0
  2. hamzy Messages postés 17 Statut Membre
     
    Merci pour ta reponse rapide pijaku.
    Jusqu'a la seconde saisie tout ce passe bien, mais lorsque j'ai une 3e ou une 4e saisie à faire, il me range la valeur du champ "destination mission" toujours sur la 1ere ligne au lieu de la ranger dans la cellule correspondant à la ligne 3 ou 4.
    je signale que j'ai une infinité de saisie à faire. je ne me limite pas qu'a 2 saisie.

    Merci pour ton aide encor une fois.
    0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    peux tu placer ici l'intégralité de ton code car là j'vois pas...
    0
  4. hamzy Messages postés 17 Statut Membre
     
    Salut Pijaku,
    il s'agit d'un programme de gestion des absences. je t'explique l'esprit du programme.
    Etant donnée qu'on a une multitude de saisie à faire, l'utilisateur ne renseigne pas toujours le champ destination mission parcequ'il apparait sur le userform que lorsque la valeur du champ motif absence contenue dans une listbox est "absence pour mission".
    lorsque dans la listbox le motif absence est par exemple: "absence mariage" le champ destination mission reste invisible et apres validation, toutes les valeurs sont rangées sur une meme ligne avec la colonne destination mission à vide. Bien evidemment.
    lorsque dans la listbox le motif absence est cette fois ci "absence pour mission" le champ destination mission est alors visible pour la saisie et après validation les valeurs des champs nom, prenom, motif absence sont toutes rangées sur la ligne suivante de la validation précédente, et seul la valeur du champ destination mission est rangée sur la 1ere ligne ou bien sur la 2e ligne lorsque la 1ere ligne correpondante à destination mission est renseignée.
    j'ai l'impression que le code que j'utilise pour le rangement du champ "destination mission" recherche dans les lignes précédentes les cellules vides et range la valeur dans la cellule trouvée.
    je souhaiterais que tout simplement apres validation de chaque saisie, les valeurs des 4 champs soient rangées sur la meme ligne. quelque soit le numero de ligne sur laquelle on se trouve.

    voici le code du bouton validation:

    Private Sub Validation_Click()
    'Sauvegarder les données dans la base de donnée excel

    Sheets("BD").Range("A65536").End(xlUp).Offset(1, 0).Value = Nom.Value
    Sheets("BD").Range("b65536").End(xlUp).Offset(1, 0).Value = Prenom.Value
    Sheets("BD").Range("c65536").End(xlUp).Offset(1, 0).Value = Motifabsence.Value
    Sheets("BD").Range("d65536").End(xlUp).Offset(1, 0).Value = destinationmission.Value

    end sub

    j'ai essayé avec ton code et ça marche avec la 2e ligne mais pour la 3e 4e 5e ligne et etc..., il affiche la valeur du champ sur la 1ere ligne.

    Merci pour ton attention et ton aide.
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,
    Je viens de tester, cela fonctionne bien chez moi...
    je reprends donc mon code avec des explications :

    Dim numligne as Integer
    numligne = Range("A65536").End(xlUp).Offset(1, 0).Row 'affecte à chaque clic sur le bouton le N° de la 1ère ligne vide de la colonne A (exemple : 5)
    Sheets("BD").Range("A" & numligne).Value = Nom.Value '"colle" la valeur de Nom en A5
    Sheets("BD").Range("B" & numligne).Value = Prenom.Value '"colle" la valeur de Prenom en B5
    Sheets("BD").Range("C" & numligne).Value = Motifabsence.Value '"colle" la valeur de Motifabsence en C5
    Sheets("BD").Range("D" & numligne).Value = destinationmission.Value '"colle" la valeur de destinationmission en D5

    Peut être pourrais tu placer une copie de ton classeur sur https://www.cjoint.com/ sans données confidentielles. Une fois ton classeur "enregistrer" sur cjoint, reviens coller le lien fournit ici même.
    0
  7. hamzy Messages postés 17 Statut Membre
     
    Merci pijaku ça marche super bien maintenant.
    j'ai 2 autres soucis.
    En premier, j'aimerais cette fois ci que mes valeurs soient rangées dans un autre fichier autre que le fichier actif.
    secondo, j'ai une macro qui me permet d'ouvrir plusieurs documents word dans lequels j'ai indiqué les chemins d'accès. A chaque fois que je deplace mes fichiers sur un autre ordi je suis obligé de modifier dans mon programme le chemin d'accès.
    Comment faire en sorte que ma macro s'exécute sans qu'a chaque fois je ne modifie le chemin des fichiers.

    voici le code actuel:

    Private Sub Cmdok_Click()
    Dim appWrd As Word.Application
    'produire document word
    Set appWD = CreateObject("Word.Application")
    If ATTCO = True Then
    appWD.Documents.Open Filename:="O:\GESTABSDOC\ATTESTATION DE CONGES.DOC"
    End If
    If ODREMI = True Then
    appWD.Documents.Open Filename:="O:\GESTABSDOC\ORDRE DE MISSION.DOC"
    End If
    If AUTOAB = True Then
    appWD.Documents.Open Filename:="O:\GESTABSDOC\Demande d'autorisation d'absence.DOC"
    End If
    End Sub

    Merci pour ton aide
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      premier souci : "enregistrer" les données dans un autre fichier
      Tout d'abord créer le fichier et le nommer basededonnees.xls.
      Ce fichier, pour simplifier le tout doit s'ouvrir en même temps que celui qui contient la macro :
      Dans le fichier "macro" : Clic droit sur l'onglet d'une feuille / Visualiser le code. VB s'ouvre.
      Dans le cadre en haut à gauche cliquer sut "this workbook".
      Dans le menu déroulant "général" choisir : Workbook
      Dans le menu déroulant (en haut de fenêtre) "déclarations" choisir : Open (si ce n'est pas fait par défaut)
      Deux lignes de code apparaissent :

      Private Sub Workbook_Open()
      
      End Sub


      entre ces deux lignes écrire :

      Dim wb As Workbook
      Set wb = Workbooks.Open("C:\Documents and Settings\il faut en fait mettre ici l'intégralité du chemin\Bureau\basededonnees.xls")
      WorkBooks("ici mets le nom du fichier qui contient la macro.xls").Activate


      Modifier la macro précédemment réalisée comme ceci (attention aux "." ils sont importants) :

      Private Sub Validation_Click() 
      Dim numligne as Integer 
           With WorkBooks("basededonnees.xls").Sheets("Feuil1")
                numligne = .Range("A65536").End(xlUp).Offset(1, 0).Row 
                     .Range("A" & numligne).Value = Nom.Value 
                     .Range("B" & numligne).Value = Prenom.Value 
                     .Range("C" & numligne).Value = Motifabsence.Value 
                     .Range("D" & numligne).Value = destinationmission.Value 
             End With
      End Sub


      Secundo : J'ai trouvé cette procédure ici code à copier/coller sous ta macro "Cmdok_click"

      Sub parcourir()
      Dim objShell As Object, objFolder As Object, oFolderItem As Object
          Dim Chemin As String
         
          Set objShell = CreateObject("Shell.Application")
          Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
         
          On Error Resume Next
          Set oFolderItem = objFolder.Items.Item
          Chemin = oFolderItem.Path
          Set objShell = Nothing
          Set objFolder = Nothing
          Set oFolderItem = Nothing
      End Sub


      Tu n'as qu'à ajouter à ta première macro : call parcourir comme ceci :
      Private Sub Cmdok_Click() 
      Dim appWrd As Word.Application 
      'produire document word 
      Set appWD = CreateObject("Word.Application")
      call parcourir 
      If ATTCO = True Then 
      appWD.Documents.Open Filename:="O:\GESTABSDOC\ATTESTATION DE CONGES.DOC" 
      End If 
      If ODREMI = True Then 
      appWD.Documents.Open Filename:="O:\GESTABSDOC\ORDRE DE MISSION.DOC" 
      End If 
      If AUTOAB = True Then 
      appWD.Documents.Open Filename:="O:\GESTABSDOC\Demande d'autorisation d'absence.DOC" 
      End If 
      End Sub 

      Ensuite remplace tes :
      Filename:="O:\GESTABSDOC\ATTESTATION DE CONGES.DOC" 

      par
      Filename:=chemin & "\ATTESTATION DE CONGES.DOC"


      Essaye et repasse au cas ou... car je n'ai rien testé....
      0
  8. hamzy Messages postés 17 Statut Membre
     
    salut pijaku,

    concernant le premier soucis, jai essayé ton code et jai un message d'erreur mais ça marche plutôt bien en le modifiant sans avoir recours au code contenu dans "Private Sub Workbook_Open()".
    voici le code que j'ai utilisé:

    Private Sub Validation_Click()
    Dim wb As Workbook
    Set wb = Workbooks.Open("O:\GESTABSDOC\basededonnees.xls")
    With Workbooks("basededonnees.xls").Sheets("BDA")
    numligne = .Range("A65536").End(xlUp).Offset(1, 0).Row
    .Range("A" & numligne).Value = Nom.Value
    .Range("B" & numligne).Value = Prenom.Value
    .Range("C" & numligne).Value = Motifabsence.Value
    .Range("D" & numligne).Value = destinationmission.Value
    end with

    end sub

    en ce qui concerne le 2e soucis j'ai testé le code. il m'ouvre une boite de dialogue me demandant de rechercher le dossier dans lequel se trouve le document avant de l'ouvrir. ceci ne repond pas à mes attentes, je souhaiterais plutôt que dès quand cliquant sur le bouton OK, il m'ouvre directement le document que je veux, sans aller rechercher le dossier qui le contient. tout comme j'arrive à le faire actuellement avec le code que je t'avais envoyé mais cette fois ci sans modifier à chaque fois le chemin d'accès sur des postes differents.

    Merci encor une fois...
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Salut,
      1er pb : pourquoi ouvrir automatiquement le classeur basededonnees? En fait, il suffit d'ouvrir les deux fichiers systématiquement et comme cela tu supprimes ces lignes (en gras) de la macro. Elles sont effectivement superflues si tu ouvres "manuellement" les 2 fichiers.
      Private Sub Validation_Click() 
      Dim wb As Workbook 
      Set wb = Workbooks.Open("O:\GESTABSDOC\basededonnees.xls") 
      'en gras lignes à supprimer

      2ème pb : Si tu veux que sur tous les postes, dans tous les cas de figure, ta macro d'ouverture des fichiers word fonctionne il faut que :
      - tes fichiers word soient dans le même répertoire (ex : C:\mesdocuments\fichiers_travail)
      - le classeur excel doit également être dans ce même répertoire...

      à ce moment, tu pourras remplacer ce qui est en italique par ce qui est dessous en gras :

      Private Sub Cmdok_Click() 
      Dim appWrd As Word.Application 
      'produire document word 
      Set appWD = CreateObject("Word.Application")
      If ATTCO = True Then 
      appWD.Documents.Open Filename:="O:\GESTABSDOC\ATTESTATION DE CONGES.DOC" 
      End If 
      If ODREMI = True Then 
      appWD.Documents.Open Filename:="O:\GESTABSDOC\ORDRE DE MISSION.DOC" 
      End If 
      If AUTOAB = True Then 
      appWD.Documents.Open Filename:="O:\GESTABSDOC\Demande d'autorisation d'absence.DOC" 
      End If 
      End Sub 

      Private Sub Cmdok_Click() 
      Dim appWrd As Word.Application 
      Dim chemin as string
      chemin = ActiveWorbook.Path
      'produire document word 
      Set appWD = CreateObject("Word.Application")
      If ATTCO = True Then 
      appWD.Documents.Open Filename:=chemin & "\ATTESTATION DE CONGES.DOC" 
      End If 
      If ODREMI = True Then 
      appWD.Documents.Open Filename:=chemin & "\ORDRE DE MISSION.DOC" 
      End If 
      If AUTOAB = True Then 
      appWD.Documents.Open Filename:=chemin & "\Demande d'autorisation d'absence.DOC" 
      End If 
      End Sub
      --
      Cordialement,
      -- Tout problème à sa solution. S'il n'y a pas de solution, ou est le problème? --
      0
  9. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Bonjour,
    pour réponde à ton probleme de chemin d'acces, le lecteur O est un lecteur réseau j'imagine ? J'imagine également que le probleme vient du fait que ce repertoire est mappé avec différentes lettres suivant les utilisateurs ? Si c'est bien le cas, tu peux utiliser le chemin d'acces complet avec le nom de serveur plutot que d'utiliser un lecteur...ex :
    \\monserveur\rep intermediaire1\rep intermediaire2\....\GESTABSDOC\ORDRE DE MISSION.DOC"

    Sinon, si les fichiers sont stockés sur disque dur, tu peux toujours voir du coté de la méthode Office.FileSearch mais attention à n'avoir qu'un seul fichier nommé comme ça sur le disque....
    0
  10. hamzy Messages postés 17 Statut Membre
     
    En ce qui concerne les documents word est-il possible qu'ils ne soient pas dans le meme repertoire que le classeur excel car je ne veux pas que les utilisateurs puisse par curiosité l'ouvrir. je veux etre le seul à connaitre l'emplacement de mes fichiers word.
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Donc il te faudra continuer à en changer le chemin de manière "manuelle" comme tu le faisais précedemment...
      0
  11. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Re,
    Aucun problème, tant que tu mets(ou détermines) le chemin d'accès dans ton code (ceci dit tu ne réponds pas à mes questions, où sont ces fichiers ? sur un serveur ? sur le disque - ceci dit un disque avec la lettre O ça parait étrange ?)...
    0
  12. hamzy Messages postés 17 Statut Membre
     
    il se trouve sur un serveur et O c'est le nom d'un lecteur.
    0
  13. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Ok, alors il te suffit de mettre le chemin d'acces complet comme je l'ai dit dans mon post précédent en passant par l'adresse plutot que par une lettre de lecteur (qui est variable apparemment) :
    "\\monserveur\monpartage\ORDRE DE MISSION.DOC"
    
    --
    On entend par une belle solution, la solution simple et facile d'un problème difficile et compliqué
    0