[VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

R@chid

XLDnaute Barbatruc
Bonsoir tout le monde,
Ce R@chid ne va pas cesser de poser les question ??
:p:eek: Non je ne vais pas cesser..

Comme vous allez voir sur le fichier joint, ( mes amis sur le forum m'ont beaucoup aidé à le faire ), je peux créer un nouveau devis sur un nouvel onglet, imprimer les devis après filtre, récupérer les montants TTC et HT des nouveaux devis, mais le problème avec les devis sur le même fichier c'est que après un certain temps il y aura un problème de ralentissement de fichier avec 200 ou 300 devis, alors je me demande si on peut faire la même chose mais cette fois avec des devis sur un fichier chacun donc à la place de créer un nouvel onglet, créer un nouveau classeur avec un seul onglet (Onglet et Classeur portant le même nom) tout en gardant la possibilité d'imprimer ces classeurs après filtres et en récupérant les montant TTC/HT après l'enregistrement de ces derniers..

Je pense que j'ai appris à rédiger les questions ;)

@ + +
 

Pièces jointes

  • Rachid_XLD2.xlsm
    55.1 KB · Affichages: 119
Dernière édition:

job75

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour R@chid, Zdz16,

Sur un tableau filtré End(xlUp) ne renvoie pas la bonne cellule.

Donc utilise :

Code:
derlig = Application.Match("zzz", [A:A])
Edit pour Zdz16 : il faudrait commencer par le commencement et lire avec soin le post #1.

A+
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour à tous

R@chid
S'il s'agit de trouver le numéro de ligne de la plage filtrée alors essaies ceci
Code:
Sub NumDerLigneFiltree()
'adapté d'un code de: Marcelo Branco
Dim derligfil&, pf As Range
Set pf = ActiveSheet.AutoFilter.Range
With pf.SpecialCells(12)
derligfil = .Areas(.Areas.Count).Row + .Areas(.Areas.Count).Rows.Count - 1
End With
MsgBox derligfil
End Sub
 

R@chid

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour les amis,
Salut Staple1600,
Merci, mais c'est pas le numéro de ligne que je cherche, le code en question récupère les montants TTC et HT des devis classés dans un dossier, mais il renvoie des montants erronés après le filtre.

@ + +
 

R@chid

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,
En fait, finalement je vais opter pour le fichier (6) comme il est conseillé par l'ami Job75, ça ne pose aucun problème avec le filtre, et en plus c'est plus rapide que le fichier (5).
Mais ça n’empêche d'attendre une solution au problème de filtre avec l'autre code, du fait que ça va m'aider beaucoup après.


@ + +
 

job75

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re, salut Staple,

Si en colonne A tu as du texte et/ou des nombres, tu peux utiliser, pour déterminer derlig :

Code:
On Error Resume Next
derlig = Application.Match(9 ^ 9, [A:A]) 'si nombres
derlig = Application.Max(derlig, Application.Match("zzz", [A:A])) 'si texte
On Error GoTo 0
La variable derlig étant bien déclarée As Long.

A+
 

job75

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

De toute façon les cellules masquées par le filtre ne prennent pas les valeurs du tableau.

Du moins sur Excel 2003.

Donc le mieux est d'afficher tout dès le début :

Code:
Private Sub Workbook_Activate()
Dim chemin As String, derlig As Long, tablo, i As Long, fich As String
Sheets("TB_DEVIS").Activate
chemin = "C:\Documents and Settings\R@chid\Bureau\DEVIS_FACTURES" & "\"
On Error Resume Next
ActiveSheet.ShowAllData 'affiche toutes les lignes du filtre
On Error GoTo 0
derlig = Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & derlig) = "" Then derlig = derlig - 1
tablo = Range("A3:J" & derlig)
For i = 1 To UBound(tablo)
  fich = Dir(chemin & tablo(i, 1) & ".xls*")
  tablo(i, 9) = "": tablo(i, 10) = ""
  If fich <> "" Then
    tablo(i, 9) = ExecuteExcel4Macro("VLOOKUP(""*TTC*"",'" & chemin & "[" & fich & "]" & tablo(i, 1) & "'!R1C1:R200C10,10,0)")
    tablo(i, 10) = ExecuteExcel4Macro("VLOOKUP(""*HT*"",'" & chemin & "[" & fich & "]" & tablo(i, 1) & "'!R1C1:R200C10,10,0)")
  End If
Next
Application.EnableEvents = False
[I3].Resize(i - 1) = Application.Index(tablo, , 9)
[J3].Resize(i - 1) = Application.Index(tablo, , 10)
Application.EnableEvents = True
End Sub
A+
 

Zdz16

XLDnaute Occasionnel
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Voici comment trouver la dernière ligne; Méthode que j'utilise souvent ne nécessitant qu'une ligne VBA


'Détermine la dernière ligne renseignée de la feuille de calculs
DerLig = Split(Worksheets("Feuil1")..UsedRange.Address, "$")(4)

Explication :
L'instruction Worksheets("Feuil1") livre l'adresse d'un plage sous le format $Colonne$Ligne:$Colonne$Ligne.
Par exemple "$A$1:$H$75". Qui n'est d'autre qu'un tableau (Chaine de caractères)

Split
Découpe en tableau une chaine selon un séparateur donné. Ici on a le $ et le :

Le tour est joué, en utilisant l'adresse renvoyée par la propriété WorkSheets("Feuil1").UsedRange.Adresse et le
séparateur "$" on obtient un tableau de dimension 4 (Contient 5 éléments car basé sur l'indice 0)
adres(0) = ""
adres(1) = "A" : Première colonne
adres(2) = "1" : Première ligne
adres(3) = "H" : Dernier colonne
adres(4) = "75" : Dernière ligne

De même si on utilise le séparateur ":" on obtient un tableau de taille 2 (0 à 1) contenant les adresses
de début et de fin de plage

adres(0) = "$A$1"
adres(1) = "$H$75" : Première colonne


Voila aux petits oignons

Cordialement
 

job75

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re Zdz16,

C'est en effet une méthode intéressante sauf que le UsedRange peut donner dans certains cas une dernière ligne très éloignée de la dernière ligne occupée.

Et alors pourquoi ne pas utiliser :

Code:
derlig = Cells.SpecialCells(xlCellTypeLastCell).Row
Mais comme R@chid l'a indiqué son problème n'est pas dû à derlig.

A+
 

R@chid

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonsoir @ tous,
Salut Job75 :) , Salut Zdz16 :)
Zdz16, peut-être que ma question était claire.

Job75, merci pour la dernière modification c'est bon sauf que, à l'activation du classeur le filtre s'efface seul :( je ne sais pas pourquoi.

@ te relire
 

job75

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour R@chid, le forum,

Dis R@chid si je mets des commentaires c'est pour que tu les lises...

Code:
ActiveSheet.ShowAllData 'affiche toutes les lignes du filtre
Mémoriser l'état initial du filtre pour le restituer à la fin serait beaucoup trop compliqué.

A+
 

job75

XLDnaute Barbatruc
Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

Finalement le plus simple est de ne pas utiliser de tableau VBA :

Code:
Private Sub Workbook_Activate()
Dim chemin As String, i As Long, fich As String
Sheets("TableauDeBord").Activate
chemin = "C:\Documents and Settings\R@chid\Bureau\DEVIS_FACTURES" & "\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("I3:J" & Rows.Count).ClearContents 'RAZ
For i = 3 To Application.Match("zzz", [A:A]) 'si textes en colonne A
  fich = Dir(chemin & Cells(i, 1) & ".xls*")
  If fich <> "" Then
    Cells(i, 9) = ExecuteExcel4Macro("VLOOKUP(""*TTC*"",'" & chemin & "[" & fich & "]" & Cells(i, 1) & "'!R1C1:R200C10,10,0)")
    Cells(i, 10) = ExecuteExcel4Macro("VLOOKUP(""*HT*"",'" & chemin & "[" & fich & "]" & Cells(i, 1) & "'!R1C1:R200C10,10,0)")
  End If
Next
Application.EnableEvents = True
End Sub
L'exécution est seulement un peu plus longue*.

Note que la variable derlig n'est pas nécessaire.

Edit : * à peine, avec 1000 fichiers devis, 6 secondes au lieu de 5,5 secondes.

Ce qui prend du temps c'est le calcul des formules.

A+
 
Dernière édition:

Discussions similaires