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.

 

[wifi7768]

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

Bonjour à Tous,
Bonjour Chti160

Concernant la mise en forme, penses tu que je puisse faire une mise en forme conditionnelle sur al colonne "J" date de révision du style
=ET($j2<>"";$j2<AUJOURDHUI()-15) alors cellule orange
=ET($j2<>"";$j2>AUJOURDHUI()-15) alors cellule verte
=ET($j2<>"";$j2<=AUJOURDHUI()-7) alors cellule rouge

ou une macro serait plus appropriée pour gérer cette condition ?

Merci

Bonne journée

 

[ChTi160]

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

Bonjour wifi7768
Bonjour le Fil

j'ai pour l'instant résolu la demande concernant le report des données triees
je regarde des que possible pour la mise en forme ( VBA )
tu sais je prends mon temps lol

Bonne fin de Journée
Amicalement
Jean marie

 

[wifi7768]

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

merci beaucoup

 

[wifi7768]

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

Bonjour à Tous,

BONNE et HEUREUSE ANNEE

 

[wifi7768]

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

Bonjour à Tous,
Bonjour Chti60,

J'ai l'impression apres usage que l'utilisation de la mise en forme conditionnelle ne se met pas à jour , une fois la ligne enregistrée ?
Chti60, Auriez-vous pu avancer sur une mise en forme en VBA, SVP ?
Merci encore.

Bonne journée

 

[wifi7768]

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

Bonsoir à Tous,

J'aurai un probleme avec ma macro, losr de l'enregistrement , il ny pas d'incremenation des lignes. Je ne peux faire que l'enregistrement d'une donnée dans mon tableau, car les suivants s'enregistrent sur la meme ligne.
Merci de votre aide.

Private Sub CommandButton1_Click()
Dim i&, dligne&, dligneCA&, ctrl As Control
Dim Nom_S_Processus As String
Dim WkB_Source As Workbook

Dim nomdoc$, DWbk As Workbook, Verif As Range, ACOPIER As Range
Dim Tab_Recup() As Variant
Dim x As Byte
Dim Str_DWbk_Name As String
Dim Str_wSht_Name As String
x = 0
Application.ScreenUpdating = False
Set WkB_Source = ThisWorkbook
Chemin = ThisWorkbook.Path & "\" ' 'on récupére le chemin
'on vérifie si la zone de texte n'est pas vide
If UserForm1.titre.Text = "" And Not (UserForm1.combo_domaine = "") Then
MsgBox ("Entrer le nom du document")
Exit Sub
End If
If UserForm1.combo_domaine.Text = "" And Not (UserForm1.titre = "") Then
MsgBox ("Entrer le domaine du document")
Exit Sub
End If
If UserForm1.combo_domaine.Text = "" And UserForm1.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 = UserForm1.titre.Text ' récupére lea valeur
With WkB_Source 'avec le Classeur
With .Worksheets("documents") 'avec la feuille"documents" de ce classeur
.Unprotect ("a") 'déverrouiller la feuille "documents"
dligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'on determine la ligne ou l'on va coller les donnees
'ci dessous on verifie si existe deja
Set Verif = .Range(.Cells(1, 8), .Cells(dligne, 8)).Find(What:=nomdoc, _
After:=.Cells(1, 8), LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Verif Is Nothing Then 'si oui message existe
MsgBox "Ce document existe déjà" 'message
Exit Sub 'on quitte ensuite
End If

'si n'existe pas
Str_DWbk_Name = UserForm1.combo_domaine.Value 'on récupére le nom du Dossier cible
Str_wSht_Name = UserForm1.CmbB_S_Processus 'on récupére le nom de la feuille Cible

For Each ctrl In Me.Controls 'pour chaque control du userform
If ctrl.Tag <> "" Then 'si la propriété Tag n'est pas vide

ReDim Preserve Tab_Recup(x) 'on redimmensionne le tableau
Tab_Recup(x) = ctrl.Value 'on y récupére la valeur du control
x = x + 1 'on incremente

ctrl.Value = "" 'on efface le control
End If
Next ctrl
.Cells(dligne, 2).Resize(1, UBound(Tab_Recup, 1) + 1) = Tab_Recup 'on colle les donnees du tableau dans la feuille "documents"
End With
End With

Set DWbk = Workbooks.Open(Chemin & Str_DWbk_Name & ".xls") 'on ouvre le Classeur cible

With DWbk
With .Worksheets(Str_wSht_Name) 'on determine la feuille Cible

.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, UBound(Tab_Recup, 1) + 1) = Tab_Recup 'on colle les donnees du tableau

Erase Tab_Recup 'on vide le tableau
End With
.Close True 'on ferme le classeur
Set DWbk = Nothing 'on vide la variable
Set WkB_Source = Nothing 'on vide la variable
Str_DWbk_Name = "" 'on vide la variable
Str_wSht_Name = "" 'on vide la variable
End With
Application.ScreenUpdating = True
End Sub

 

[ChTi160]

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

Bonsoir
Peux tu mettre le fichier ou se trouve la macro
Merci
Amicalement
Jean marie

 

[Staple1600]

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

Bonjour à tous

Juste pour un petit coucou d'un JM à un autre.
(je suis toujours ce fil mais suis en mode lecture seule pour le moment )
Continuez les gars, vous tenez le bon bout !

PS: Si je trouve un peu de temps, je repasserai vous filer un petit coup de main, si besoin

 

[ChTi160]

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

Bonjour wifi7768
un coucou particulier a JM
Bonjour le Fil
ton problème de report vien s surement du fait que dans la macro on détermine la ligne ou vont être colle les données à partir de la Colonne 1 voir ci dessous (.Cells(.Rows.Count, 1))

.Unprotect ("a") 'déverrouiller la feuille "documents"
     dligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'on determine la ligne ou l'on va coller les données

puis on colle les données à partir de la colonne 2 voir ci dessous (.Cells(dligne, 2))
Next ctrl

.Cells(dligne, 2).Resize(1, UBound(Tab_Recup, 1) + 1) =  Tab_Recup 'on colle les donnees du tableau dans la feuille "documents"

donc a voir
ensuite il faudra que tu me rafraichisses la mémoire sur ce que tu veux faire (si on doit continuer) lol
bonne journée
Amicalement
Jean Marie

 

[wifi7768]

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

Bonsoir CHTI160, Bonsoir Staple1600

Je viens d'essayer en changeant (.Cells(.Rows.Count, 1)) en (.Cells(.Rows.Count, 2)) et cela semble fonctionner, et plus de blocage suir la ligne 19.
En revanche , les donnees dans mon USERFORM ne se vident plus apres avoir alimenté la page "Documents" ?? Auriez-vosu une idée ?

Sinon ceci devrait servir à une base documentaire, afin de dispatcher les documents en fonction du proceesus et du sous-^processus qualié auxquels ils appartiennent, dans 4 autres classeurs qui se trouvent dans le meme répertoire.

Merci encore de votre aide.

PS :j'ai également modifié Set Verif = .Range(.Cells(1, 8) en (.Cells(1, 9) afin de vérifier si la saisie "titre document" existait deja.

 

[wifi7768]

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

Bonjour à Tous,

Je me permets de revenir vous , pour mon formualire qui ne se vide pas des données à fin de la validation.
Pourriez-vous me donner un coup de main, SVP ?
Merci.
Bonne journée