dispatcher données de BDD sur classeur et onglet

[wifi7768]

Bonjour,

Je suis nouveau sur le forum et débutant en excel...
J'ai une BDD alimentée par un USF. Cette BDD comporte 8 colonnes, avec la première colonne "procéssus" et la 2eme colonne "sous-processus".
Je souhaiterais pouvoir apres avoir renseigné mon USF pour alimenter ma BDD, que les 2 premières colonnes soient riées dans un classeur X existant (en fonction du nom (4 possibilités) de la cellule de la 1ere colonne "processus" ) et dans un onglet existant, dans ce fameux classeur X , fonction du nom des cellules de la 2eme colonne (sous processus).
Merci de votre aide.

Je joins le code du formulaire pour remplir la BDD.
Le fichier excel est trop lourd pour être posté 🙁

Private Sub ajout_donnes_Click()

    
    Worksheets("donnees").Visible = True 'afficher la feuille "donnees"
    Worksheets("interface").Visible = False 'afficher la feuille "interface"
    Worksheets("documents").Visible = False 'masquer la feuille "document""
 
    Unload Me 'Fermer la boite de dialogue
    ajoutdon.Show 'afficher la boite de dialogue "ajoutdon"
    
End Sub

Private Sub ajouter_doc_Click()


 Worksheets("documents").Unprotect ("a") 'verrouiller la feuille "documents"


'on vérifie si la zone de texte n'est pas vide
    If titre.Text = "" And Not (combo_domaine = "") Then
        MsgBox ("Entrer le nom du document")
        Exit Sub
    End If
    
    
    If combo_domaine.Text = "" And Not (titre = "") Then
        MsgBox ("Entrer le domaine du document")
        Exit Sub
    End If

    If combo_domaine.Text = "" And titre.Text = "" Then
        MsgBox ("Entrer le domaine et le titre du document")
        Exit Sub
    End If



'On vérifie si le domaine n'existe pas

For i = 1 To (Worksheets("documents").Cells(1, 1))
If titre = Worksheets("documents").Cells(i, 4) Then
     MsgBox ("ce documents existe déjà")
        Exit Sub
    End If

Next



' recherche de la ligne vide
    ligne = 2
    Do While Cells(ligne, 4).Text <> ""
        ligne = ligne + 1
    Loop
      Cells(ligne, 2) = combo_domaine 'ajout du nom du domaine
      Cells(ligne, 3) = combo_SD 'ajout du nom du sous-domaine
      Cells(ligne, 4) = titre 'ajout du nom du document
      Cells(ligne, 5) = auteur1 'ajout du nom de l'auteur
      Cells(ligne, 6) = auteur2 'ajout du nom de l'auteur2
      Cells(ligne, 7) = ncbox4 'ajout de la date
      Cells(ligne, 8) = TextBox1 'ajout de la date
      Cells(ligne, 9) = biblio 'ajout de la bibliographie
      Cells(ligne, 10) = ncBox5 'ajout de la date revision
      
      Worksheets("documents").Rows(ligne).Select
      Selection.EntireRow.Hidden = False
      
    Worksheets("documents").Protect ("a") 'verrouiller la feuille "documents"

MsgBox ("le nouveau document a bien été ajouté à la liste")

'Vider les zone de saisie
combo_domaine = ""
combo_SD = ""
titre = ""
auteur1 = ""
auteur2 = ""

End Sub
Private Sub annuler_Click() 'retourner à l'acceuil de la base de données
    
    Worksheets("donnees").Visible = False 'masquer la feuille "donnees"
    Worksheets("interface").Visible = True 'afficher la feuille "interface"
    Worksheets("documents").Visible = False 'masquer la feuille "document""
    Unload Me 'Fermer la boite de dialogue
    
End Sub

Private Sub auteur1_Change()

End Sub

Private Sub auteur2_Change()

End Sub

Private Sub combo_domaine_Change()
If combo_domaine.Value = "" Then
        combo_SD.RowSource = ""
        combo_SD.Value = ""
    Else
        Select Case combo_domaine.ListIndex
            Case 0
                combo_SD.RowSource = "Liste!B1:B6"
            Case 1
                combo_SD.RowSource = "Liste!C1:C6"
            Case 2
                combo_SD.RowSource = "Liste!D1:D10"
            Case 3
                combo_SD.RowSource = "Liste!E1:E7"
        End Select
    End If
End Sub


Private Sub combo_SD_Change()

End Sub

Private Sub Label6_Click()

End Sub

Private Sub Label8_Click()

End Sub

Private Sub Label9_Click()

End Sub

'Afficher date d'enregistrement dans formulaire
Sub Affich_date()
ncbox4.Value = Format(DateSerial(spban.Value, spbmois.Value, spbjour.Value), "dd/mm/yyyy")
End Sub


Private Sub ncbox4_Change()

End Sub

Private Sub spban_Change()
    Affich_date
End Sub
Private Sub spbjour_Change()
    If spbjour.Value = 0 Then
        spbjour.Value = 31
    ElseIf spbjour.Value = 32 Then
        spbjour.Value = 1
    End If
    Affich_date
End Sub

Private Sub spbmois_Change()
    If spbmois.Value = 0 Then
        spbmois.Value = 12
    ElseIf spbmois.Value = 13 Then
        spbmois.Value = 1
    End If
    Affich_date
End Sub
'Afficher date d'enregistrement dans formulaire
Sub Affich_date1()
ncBox5.Value = Format(DateSerial(spban1.Value, spbmois1.Value, spbjour1.Value), "dd/mm/yyyy")
End Sub


Private Sub ncbox5_Change()

End Sub

Private Sub spban1_Change()
    Affich_date1
End Sub
Private Sub spbjour1_Change()
    If spbjour1.Value = 0 Then
        spbjour1.Value = 31
    ElseIf spbjour1.Value = 32 Then
        spbjour1.Value = 1
    End If
    Affich_date1
End Sub

Private Sub spbmois1_Change()
    If spbmois1.Value = 0 Then
        spbmois1.Value = 12
    ElseIf spbmois1.Value = 13 Then
        spbmois1.Value = 1
    End If
    Affich_date1
End Sub
Private Sub TextBox1_Change()

End Sub

Private Sub titre_Change()

End Sub

Private Sub UserForm_Activate()

    For i = 2 To (Worksheets("donnees").Cells(2, 1) + 1) 'remplir la combobox domaine
        combo_domaine.AddItem Worksheets("donnees").Cells(i, 2)
    Next
    
    For i = 2 To (Worksheets("donnees").Cells(2, 4) + 1) 'remplir la combobox sous-domaine
        combo_SD.AddItem Worksheets("donnees").Cells(i, 5)
    Next

    For i = 2 To (Worksheets("donnees").Cells(2, 7) + 1) 'remplir les comboboxs auteur
        auteur1.AddItem Worksheets("donnees").Cells(i, 8)
        auteur2.AddItem Worksheets("donnees").Cells(i, 8)
    Next
    
    
    
biblio.AddItem "VERSION" 'ajouter la valeur "X" à la liste de choix

End Sub

A bientôt.

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour à tous


wifi7748
Oui c'est possible, mais ne sois pas pressé 😉
Je ne fais des tests sur Excel que le soir venu une fois le dur labeur achevé 😉
Dinc que penses-tu de se passer de feuilles pour stocker les données qui remplissent les ComboBox?
Tu prends ou tu gardes?

Pour ceci, j'ai encore besoin d'explications (désolé 😉

Ainsi à partir de la BDD , un tri des documents à fin de la saisi, en fct du processus et sous-processus dans le classeur excel en question.

Tu veux trier sur la 1ère et seconde colonne (Soit colonne A et B de la feuille documents)
Une fois ce tri effectué, on va ouvrir un classeur (ex: Management) et on vient copier/coller dans celui-ci ce que l'userform vient d'injecter dans la feuille documents?

C'est bien cela?

 

[wifi7768]

Re : dispatcher données de BDD sur classeur et onglet

Staple 1600,
Rebonjour,

Oui, tres tres bien de se passer de feuilles pour stocker les données remplissant les combobox. Je pense cela allege considérablement le systeme ?
En revanche j'ai d'autres modules qui viennent se greffer par la suite sur BDD, comme recherche, ou ajout ou modi de données..mais on verra cela plus tard..
Je pense que l'on peut continuer dans ce sens.

Tu veux trier sur la 1ère et seconde colonne (Soit colonne A et B de la feuille documents)
Une fois ce tri effectué, on va ouvrir un classeur (ex: Management) et on vient copier/coller dans celui-ci ce que l'userform vient d'injecter dans la feuille documents?

C'est bien cela?

Oui tout à fait, ceci doit apparaitre "invisible" à la personne qui incrémente la BDD par le USF, en revanche si il veut consulter les classeurs(ex: management) en question , il verra que c'est trié (feuilles) en fonction des sous-processus (colonne B).
je joins le classeur exemple pour Management que l'on souhaiterait obtenir apres le tri.

Bonne journée

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonsoir à tous

wifi7748
Voilà ou j'en suis pour le moment pour la recopie des données
Cela fonctionne (test OK avec Management.xls)
Je suppose que selon le sous-processus renseigné, il faut copier les données dans la feuille dont le nom est identique à ce sous-processus.
C'est bien cela?
Je te laisse tester et plus.
Ce soir je ne serai pas trop sur XLD.
Ce qui te donnera l'occasion de mettre u peu les mains dans le cambouis 😉 d'Excel.

PS: J'ai testé ce code et il fonctionne donc si cela ne marche pas chez toi, relis bien mon message et cherche alors quelles erreurs tu auras pu commettre.

Private Sub CommandButton1_Click()
Dim i&, dligne&, dligneCA&, ctrl As Control
Dim DWbk As Workbook
Dim ACOPIER As Range
'equivalent de Sub ajouter_doc_Click()
Worksheets("documents").Unprotect ("a") 'déverrouiller la feuille "documents"
'on vérifie si la zone de texte n'est pas vide
    If titre.Text = "" And Not (combo_domaine = "") Then
        MsgBox ("Entrer le nom du document")
        Exit Sub
    End If
    If combo_domaine.Text = "" And Not (titre = "") Then
        MsgBox ("Entrer le domaine du document")
        Exit Sub
    End If
    If combo_domaine.Text = "" And titre.Text = "" Then
        MsgBox ("Entrer le domaine et le titre du document")
        Exit Sub
    End If
'On vérifie si le domaine n'existe pas
For i = 1 To (Worksheets("documents").Cells(1, 1))
If titre = Worksheets("documents").Cells(i, 4) Then
     MsgBox ("Ce document existe déjà")
        Exit Sub
    End If
Next
dligne = Cells(Application.Rows.Count, 4).End(xlUp).Row + 1
For Each ctrl In Me.Controls
    If ctrl.Tag Like "col*" Then
    Cells(dligne, 1 * Mid(ctrl.Tag, 4, 2)) = ctrl.Value
    End If
Next ctrl
'recopie (test ok)
dligneCA = Worksheets("documents").Cells(Application.Rows.Count, 4).End(xlUp).Row
Set ACOPIER = Rows(dligneCA).SpecialCells(xlCellTypeConstants)
Chemin = ThisWorkbook.Path & "\"
Set DWbk = Workbooks.Open(Chemin & ACOPIER.Range("A1").Text & ".xls")
ACOPIER.Copy DWbk.Sheets(1).[A65536].End(xlUp)(2)
End Sub

 

[wifi7768]

Re : dispatcher données de BDD sur classeur et onglet

Bonsoir à Tous,
Bonsoir Staple 1600

J'ai testé , cela fonctionne pour management. MERCI !!
Cela ouvre le fichier excel, ce n'est pas nécéessaire, mais pas bien grave

Je suppose que selon le sous-processus renseigné, il faut copier les données dans la feuille dont le nom est identique à ce sous-processus.
C'est bien cela?

oui c'est tout à fait cela STP.

merci encore pour ce travail.

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Re,

C'est effectivement plus simple si tout tes fichiers sont ouverts dans la même instance Excel.

Tu auras adapter le code en conséquence ?

Une petite suggestion: afin de limiter les erreurs possibles, il serait judicieux d'harmoniser le nom des classeurs des feuilles et des items des combobox.
Ainsi soit c'est partout MANAGEMENT ou partout Management etc....; mais pas un fois et une fois l'autre.

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonsoir à tous

wifi7768
Voici mes derniers tests (ok ici en utilisant l'userform joint dans mon précédent message et ici MANAGEMENT.xls est déjà ouvert)
Je te laisse modifier les tags des contrôles et découvrir quels autres modifications faire pour que le code ci-dessous fonctionne correctement.
J'attends tes commentaires (ainsi d'ailleurs qu'une implication de ta part un peu plus poussée 😉 )

Private Sub CommandButton1_Click()
Dim i&, dligne&, dligneCA&, ctrl As Control
Dim nomdoc$, DWbk As Workbook, Verif As Range, ACOPIER As Range
'equivalent de Sub ajouter_doc_Click()
With Worksheets("documents")
.Unprotect ("a") 'déverrouiller la feuille "documents"
'on vérifie si la zone de texte n'est pas vide
    If titre.Text = "" And Not (combo_domaine = "") Then
        MsgBox ("Entrer le nom du document")
        Exit Sub
    End If
    If combo_domaine.Text = "" And Not (titre = "") Then
        MsgBox ("Entrer le domaine du document")
        Exit Sub
    End If
    If combo_domaine.Text = "" And titre.Text = "" Then
        MsgBox ("Entrer le domaine et le titre du document")
        Exit Sub
    End If
'On vérifie si le domaine n'existe pas
nomdoc = titre.Text
Set Verif = .Columns("H:H").Find(What:=nomdoc, _
After:=.[H2], LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Verif Is Nothing Then
MsgBox "Ce document esiste déjà"
Exit Sub
End If
dligne = .Cells(Application.Rows.Count, 1).End(xlUp).Row + 1
For Each ctrl In Me.Controls
    If ctrl.Tag Like "col*" Then
    MsgBox CLng(Mid(ctrl.Tag, 4, 2))
    .Cells(dligne, CLng(Mid(ctrl.Tag, 4, 2))) = ctrl.Value
    End If
Next ctrl
'recopie bis (test ok)
dligneCA = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set ACOPIER = .Rows(dligneCA).SpecialCells(xlCellTypeConstants)
End With
Set DWbk = Workbooks(combo_domaine & ".xls")
ACOPIER.Copy DWbk.Sheets(CStr(combo_SD)).[A65536].End(xlUp)(2)
End Sub

 

[wifi7768]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour à Tous,

Bonjour Staple 1600.

Merci de ton dernier message, je vais tester, et te tiens au courant.
Désolé de ma non implication, mais je suis débutant, donc tres délicat de faire des commentaires à des gens qui maitrisent excel...😱 ce serait probablement mal venu.
Mais je reviens vers toi le plus rapidement possible.

Bonne journée.

PS : en testant j'aurais un message d'erreur 1004 pas de cellules correspondantes
avec la ligne Set ACOPIER = .Rows(dligneCA).SpecialCells(xlCellTypeConstants) surlignée en jaune ?
merci

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour à tous

wifi7768
Commentes tant que tu veux, impliques toi comme tu peux
Le principal c'est de sentir que le demandeur mets les mains dans le cambouis. 😉
(Pour le message d'erreur , teste en ajoutant ceci dans un permier temps
On Error Resume Next

'recopie bis (test ok)
On Error Resume Next
dligneCA = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set ACOPIER = .Rows(dligneCA).SpecialCells(xlCellTypeConstants)
End With
Set DWbk = Workbooks(combo_domaine & ".xls")
ACOPIER.Copy DWbk.Sheets(CStr(combo_SD)).[A65536].End(xlUp)(2)

Je repasse ce soir pour plus de détails et compléments.

 

[wifi7768]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour a Tous,

Bonjour Staple

J'ai donc ajouté "On error resume next", et j'obtiens un message : erreur de compilation sub ou function non définie avec endwith surligné en bleu.

J'ai donc essyé de mettre end with , je n'ai plus le message , mais le fichier management (qu'il soit ouvert ou non), et bien au meme niveau que le fichier comportant la feuille "documents" n'est pas alimentée ?

Bonne journée.

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour wifi7768


As-tu bien modifié les numéros des Tags
(voir ce que j'en dis dans mes précédents messages, que je te conseille de relire posément)

Chez moi le test fonctionne.

Désolé mais il faut que je parte au boulot.

Espérons que d'autres ici viendront prendre le relais.

En attendant zou plonge dans le cambouis, l'avantage de celui d'Excel et VBA c'est qu'il ne tache pas.

 

[ChTi160]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour wifi7768
Bonjour JM
Bonjour le Forum
pendant que certains travaillent
je regarde de loin , car je n'ai pas tout compris Lol
je me permets donc de proposer cette petite simplification "histoire de pouvoir vous saluer" car elle n'est pas indispensable Lol
On remplace ceci :

If titre.Text = "" And Not (combo_domaine = "") Then
        MsgBox ("Entrer le nom du document")
        Exit Sub
    End If
    If combo_domaine.Text = "" And Not (titre = "") Then
        MsgBox ("Entrer le domaine du document")
        Exit Sub
    End If
    If combo_domaine.Text = "" And titre.Text = "" Then
        MsgBox ("Entrer le domaine et le titre du document")
        Exit Sub
    End If

par Cela :

With Userform1
   If .combo_domaine.Text = "" Or .titre.Text = "" Then
       MsgBox ("Entrer " & IIf( .combo_domaine.Text = "","le domaine"," le titre du document"))
           Exit Sub
  End If
End With

Bonne journée car je vais devoir moi aussi partir au Boulot
Amicalement
Jean Marie

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonsoir à tous


Merci d'un JM à autre JM d'avoir pris le relais 😉

wifi7768
As-tu peux faire les modifications nécessaires?
Le tag est une propriété des contrôles que l'on peut disposer sur un userform
Pour afficher une propriété d'un contrôle, il faut dans VBE aller sur la fenetre Propriétés
Dans l'userform que j'avais joint initialement, ils étaient renseignés d'une façon qui n'est pas compatible avec la dernière macro proposée.
Il faut changer la numérotation 02 devenant 01 etc...
C'est cette partie du code (tiens d'ailleurs j'avais oublié de retirer le MsgBox 😛) qui utilise le tag
ForEach ctrl In Me.Controls
If ctrl.Tag Like"col*"Then
'MsgBox CLng(Mid(ctrl.Tag, 4, 2))
.Cells(dligne, CLng(Mid(ctrl.Tag, 4, 2))) = ctrl.Value
EndIf
Next ctrl

J'ai mis un tag sur chaque contrôle dont la valeur devra être insérer sur la feuille
J'ai donc mis les tags suivants sur les contrôles concernés:
col01 col02, etc.. , la valeur numérique représentant le numéro de colonne de la feuille
ex col01 pour la colonne A.
(Mais ce n'était pas encore le cas sur l'userform fourni qui lui avait des tags commençant en col02)
D'ou la nécessite de devoir renommer les tags correctement.

Je te laisse donc faire cette opération et retester la macro ensuite.

 

[wifi7768]

Re : dispatcher données de BDD sur classeur et onglet

Bonsoir à Tous,

JM et Staple,

Je vais regarder tout cela le plus tôt possible et reviens vers vous.

Merci.

PS : j'ai testé en modifiant les tags comme tu me l'as dit et mis un fichier "Management" à la même racine, mais ce dernier n'est pas alimenté lors de l'incrementation du premier.
Je n'ai plus de message d'erreur.

 

[Staple1600]

Re : dispatcher données de BDD sur classeur et onglet

Bonne nuit à tous

Chez moi harmonie il y a, alors la macro fonctionne sans embarras 😉
https://www.excel-downloads.com/threads/dispatcher-donnees-de-bdd-sur-classeur-et-onglet.196323/

 

[wifi7768]

Re : dispatcher données de BDD sur classeur et onglet

Bonjour à Tous
Bonjour Staple 1600

Je pense donc avoir harmonisé le nom des classeurs , des feuilles et des combobox.
J'ai une erreur à ce niveau : erreur d'execution 9 l'indice n'appartient pas à la séléction
Set DWbk = Workbooks(combo_domaine & ".xls")

Est-ce que le classeur correspondant au combo domaine (réalisation, ou management, ou support, amélioration) doit être ouvert ? Je ne pense pas, j'ai testé ouvert ou non et j'ai le meme message d'erreur.

Désolé du dérangement !! et de mon ignorance.

Merci encore