Discussion :

[thierry78420]

Si la veille tu as déjà ouvert ton dossier donc la veille tu aura un message "5 dossiers archivés" et aujourd'hui qd tu vas ouvrir ton dossier tu aura message 01 dossier archivé mais si la veille tu n'as pas ouvert ton dossier donc les 5 dossiers ne sont pas déja archivés ; aujourd'hui le code va archivé tous les dossiers échus et va envoyer un message : "6 dossiers archivés puisque le code ne prends pas en compte la date d'aujourd'hui mas tous les dossiers ayant une date EGALE ou INFERIEURE à aujourd'hui
Autre piste : au lieu d'un compteur tu peux simplement chercher la dernière ligne de la feuille archivage avant l’exécution de la boucle et la dernière ligne après la boucle et 1-2 tu aura la nombre des lignes transférés
pour chercher la dernière ligne non vide

Bonjour,

Tout d'abord un grand merci pour toute l'aide que vous m'avez apporté à la concrétisation de mon projet.

Celui-ci arrive à terme, je n'ai plus qu'à créer un onglet de recherche sur le référent afin de savoir combien de dossier lui son attribués.

Je rencontre des problèmes avec la fonction "RECHERCHEV" pourquoi je n'en sais strictement rien

Comme vous pourrez le voir j'ai changé l'ordre des colonne de mon tableau de recherche afin d'avoir en premier la cellule Réf1 en premier.

Concernant l'onglet IP rien a changé, c'est à l'identique de ce que vous connaissez.

Avez vous une idée de ce qui fait que je n'arrive pas à renseigner mes cellules avec cette fonction.

Merci beaucoup

au plaisir de vous lire

Cdlt, Thierry

[BENNASR]

bonjour
désolé de répondre tard cause congé
1 - Tu cherche dans l'onglet des dossiers en cours et non pas dans l'archive?? ou bien dans les deux??
2 - Si tu cherches dans les projet en cours (d'ailleurs c'est ce que je voie sur le fichier joint) tu peux simplement filtré tes données
pour filtrer avec un code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub filtrerDonnées()
Dim F As Worksheet
Dim I As Long
 Application.ScreenUpdating = False
 Set F = Sheets("IP")
 With F
    If Not .AutoFilter Is Nothing Then
      If .FilterMode Then .ShowAllData
      .AutoFilter.Range.AutoFilter
    End If
I = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("B7:T" & I).AutoFilter field:=2, Criteria1:=F.Cells(4, "L")
End With
 Application.ScreenUpdating = True
End Sub

[thierry78420]

Bonjour BENNARS?
Vous n'avez pas à vous excusez je vous remercie beaucoup pour l'aide que vous m'apportez

je souhaite par le biais d'un bouton(Pourquoi pas) rechercher dans l'onglet "IP" tous les dossier rattachés à un referent et faire une copie sans modifier la BDD(IP) .

Le nom de l'onglet doit etre "Référent" . par contre à chaque recherche il faut effectuer un delete des enregistrements si trouvant puisque l'on veut voir que le referent selectionné dans la cellule recherche.


Cdlt, Thierry

[BENNASR]

bonjour
filtre selon donnée colonne C (prénom)
à adapter si nécessaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub filtrerDonnées()
Dim F As Worksheet
Dim F2 As Worksheet
Dim I As Long
Dim lig As Long
 Application.ScreenUpdating = False
 Set F = Sheets("IP")
 Set F2 = Sheets("recherche")
 
If Not F.AutoFilter Is Nothing Then
If F.FilterMode Then F.ShowAllData
F.AutoFilter.Range.AutoFilter
End If
I = F.Cells(Rows.Count, 2).End(xlUp).Row
lig = F2.Cells(Rows.Count, 2).End(xlUp).Row
 
F.Range("B7:T" & I).AutoFilter Field:=2, Criteria1:=F2.Cells(4, "F")
 
F2.Range("B7:T" & lig).ClearContents
 
F.Range("B7:T" & F.Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("B7")
 
F.AutoFilter.Range.AutoFilter
 Application.ScreenUpdating = True
End Sub

[thierry78420]

Excellent concernant votre exemple
Par contre lorsque je copie votre programme dans mon fichier je rencontre un soucis au niveau du filtre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub filtreRef()

Dim F As Worksheet
Dim F2 As Worksheet
Dim I As Long
Dim lig As Long

 Application.ScreenUpdating = False
 Set F = Sheets("IP")
 Set F2 = Sheets("IP par Referent")
 
If Not F.AutoFilter Is Nothing Then
    If F.FilterMode Then F.ShowAllData
    F.AutoFilter.Range.AutoFilter
End If

I = F.Cells(Rows.Count, 2).End(xlUp).Row
lig = F2.Cells(Rows.Count, 2).End(xlUp).Row
 
F.Range("B7:T" & I).AutoFilter Field:=2, Criteria1:=F2.Cells(4, "F") probleme sur cette ligne 
 
F2.Range("B7:T" & lig).ClearContents
 
F.Range("B7:T" & F.Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("B7")
 
F.AutoFilter.Range.AutoFilter
 Application.ScreenUpdating = True


End Sub

De plus lorsque je regarde votre développement je m'aperçois que vous avez mis plusieurs modules?
dois je les mettre ?
J'ai fais en sorte que ma feuille recherche par référent soit à l'identique que IP
J'avoue avoir du mal à déchiffrer ===>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

F.Range("B7:T" & I).AutoFilter Field:=2, Criteria1:=F2.Cells(4, "F")

Voilà ,
Encore merci super boulot

Au plaisir de vous lire

Cdlt Thierry

[BENNASR]

que un module est nécessaire..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

F.Range("B7:T" & I).AutoFilter Field:=2, Criteria1:=F2.Cells(4, "F")

c a d filtrer la feuille F quand la valeur de la colonne C (puisque notre tableau commence depuis la colonne B) egale à F4 de l'onglet "IP par Referent"
si tu t'en sors pas tu peux envoyé un fichier test avec qq lignes (non confid) pour cerner le probleme

[thierry78420]

que un module est nécessaire..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

F.Range("B7:T" & I).AutoFilter Field:=2, Criteria1:=F2.Cells(4, "F")

c a d filtrer la feuille F quand la valeur de la colonne C (puisque notre tableau commence depuis la colonne B) egale à F4 de l'onglet "IP par Referent"
si tu t'en sors pas tu peux envoyé un fichier test avec qq lignes (non confid) pour cerner le probleme

Je préfère vous envoyer mon dossier. Cela sera plus clair pour vous.

Et encore un grand merci.

Thierry

[BENNASR]

a tester

[thierry78420]

a tester

Et bien vous êtes un chef, je vous envoie les félicitations de toutes les personnes qui vont l'utiliser prochainement, je leur ai présenté ce soir rapidement, ils sont ravis.

Pour le moment, je continue les testes.

=========== Question de mon Equipe =======

Est ce possible lorsque nous saisissons le nom d'une nouvelle famille de créer en parallèle un dossier word au meme nom et mettre le chemin dans la cellule autre "S8".

Ce document Word servira au référent de mettre toutes ces actions effectuées afin que si un collègue reprend son dossier qu'il puissent savoir ce qu'il a ete fait?

Encore un grand merci pour l'aide apporté à ce projet.

Bonne soirée

Thierry

[thierry78420]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub OuvrirWord()
Set WordApp = CreateObject("word.Application")
WordApp.Visible = True
Famille = InputBox("Mettre le nom de la Famille")
WordApp.documents.Open "C:\Users\Thierry\Documents\Dept 92\Famille.doc"
WordApp.Activate
End Sub

J'ai créé ce module mais a priori il n'aime pas.
?
slt

[BENNASR]

Bonjour thierry et toute l'équipe
Avant de clôturer ce sujet je vais supprimer les anciens pièces jointes pour décharger ce super site par des fichiers inutiles
ton problème viens de l'inactivation de Microsoft Word depuis Excel :
1- Tu dois activer dans VBAProject word si n'est pas activé : voir Outils/Références/ et tu coches Microsoft Word 14 object library
2- Créer un nouveau dossier ou tu vas archivés tes documents Word : Dans mon code c'est un dossiers nommé WORD qui existe sur le bureau
3- Aller sur l'onglet "Paramètrage" et tu sélectionne le nom de la famille que tu veux créer un dossier
4- Tu clique sur le bouton qui va créer un nouveau fichiers ... si le fichier existe le code va stopper la création (pour les testes tu peux effacer le chemin dans la colonne C
5- dans l'onglet IP en cours tu cherche le lien via index et equiv : INDEX(Treferent;EQUIV(IP!J8;Treferent[Référent];0);2)
6- selectionner la colonne C de la feuille paramétrage ou bien la colonne S de la feuille IP et clic droite avec la souris et choisir lien hypertexte et choisir le dossier ou tu stock les documents word comme ça et a chaque clic tu te dirige vers le dossier et l'utilisateur n'a qu'a choisir le fichier
à mon niveau d'autodidacte VBA je ne sais pas comment faire ça avec VBA
j'espère que ça t'aide à avancer dans ton projet


ca qui donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub CreerOuvrirWord()
Dim Param As Worksheet
Dim appWrd As Word.Application
Dim docWrd As Word.Document
Dim NomDoc As String
Set Param = Sheets("Paramètrage")
Nom = Param.Cells(ActiveCell.Row, 2)
If Nom = "" Or Param.Cells(ActiveCell.Row, 3) <> "" Then
MsgBox "Vous n'avez pas selectionné une famille ou bien cette famille dispose d'un dossier word !!!"
Exit Sub
Else
Set appWrd = CreateObject("Word.Application")
appWrd.Visible = True
Set docWrd = appWrd.Documents.Add
docWrd.SaveAs "C:\Users\DELL\Desktop\WORD\" & Nom
Param.Cells(ActiveCell.Row, 3) = "C:\Users\DELL\Desktop\WORD\" & Nom
End If
End Sub

[thierry78420]

MERCI, Impeccable

Est ce que je peux directement travailler avec "IP" a la place de Paramètrage car le nom de la famille je ne la connais pas par avance.

Si je peux fonctionner avec la cellule "C" cela m'arrange enormément comme ca je peux mettre ta procedure dans chaque cellule "S" de IP.

Un grand Merci à toi pour ta rapidité et ta disponibilité.

Je prepare mon tutoriel explicatif de ce projet afin de pouvoir le mettre en activité debut novembre.

Slt

[BENNASR]

bonjour
donc vous voulez créer un fichier Word pour chaque nom se trouve en colonne C de l'onglet IP
si oui :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub CreerOuvrirWord()
Dim Param As Worksheet
Dim appWrd As Word.Application
Dim docWrd As Word.Document
Dim NomDoc As String
Set IP = Sheets("IP")
Nom = IP.Cells(ActiveCell.Row, 3)
If ActiveCell.Column <> 3 Or Nom = "" Or IP.Cells(ActiveCell.Row, 19) <> "" Then
MsgBox "Vous n'avez pas selectionné une valeur de la colonne B ou bien cette personne dispose déja d'un dossier word !!!"
Exit Sub
Else
Set appWrd = CreateObject("Word.Application")
appWrd.Visible = True
Set docWrd = appWrd.Documents.Add
docWrd.SaveAs "C:\Users\DELL\Desktop\WORD\" & Nom
IP.Cells(ActiveCell.Row, 19) = "C:\Users\DELL\Desktop\WORD\" & Nom
End If
End Sub

[thierry78420]

PARFAIT , EXCELLENT BENNARS

Pour terminer mon projet, dans mon onglet "Recherche par famille" , j'aimerais mettre une icône "Word" comme vous l'avez fait sur "IP" afin de récupérer le fichier Word créé au nom de la famille mais sur le numéro du dossier qui lui est unique. (Ceci afin de ne pas se tromper sur les homonymes). La cellule concernée est en grisée rouge.

Cordialement, Thierry

Mille merci

[thierry78420]

bonjour
filtre selon donnée colonne C (prénom)
à adapter si nécessaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub filtrerDonnées()
Dim F As Worksheet
Dim F2 As Worksheet
Dim I As Long
Dim lig As Long
 Application.ScreenUpdating = False
 Set F = Sheets("IP")
 Set F2 = Sheets("recherche")
 
If Not F.AutoFilter Is Nothing Then
If F.FilterMode Then F.ShowAllData
F.AutoFilter.Range.AutoFilter
End If
I = F.Cells(Rows.Count, 2).End(xlUp).Row
lig = F2.Cells(Rows.Count, 2).End(xlUp).Row
 
F.Range("B7:T" & I).AutoFilter Field:=2, Criteria1:=F2.Cells(4, "F")
 
F2.Range("B7:T" & lig).ClearContents
 
F.Range("B7:T" & F.Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("B7")
 
F.AutoFilter.Range.AutoFilter
 Application.ScreenUpdating = True
End Sub

Bonsoir BENNARS

Lorsque je protège ma feuille "IP" mon Filtre ne fonctionne plus

Y a t il un codage spécifique à rajouter pour que cela fonctionne feuille protégée?

Mon deuxième problème est que si ma date de transfert est vide le programme plante à l'ouverture.

Ma démonstration devant mon équipe a été catastrophique.

Je ne peux m'en prendre qu'à moi même pas assez travaillé le sujet et testé toutes les finalités.

Merci d'avance pour l'aide que vous m'apportez

bonne soirée

Thierry