bonjour tout le monde,
j'ai encore deux ptits problemes :
afficher automatiquement une bordure sous le dernier produit entré et sous les 3 cellules à coté, exemple :
j'entre dans D24 un produit une bordure (*) s'affiche sous D24, E24, F24 et G24 . Si j'entre un deusième produit dans D25 la bordure (*) s'affiche dans D25, E25, F25 et G25 en s'enlevant de D24, E24, F24 et G24
le but c'est d'avoir toujours une bordure sous le dernier produit saisi
dans mon fichier la saisie des produits se fait par un click dans une liste ce qui pourrait compliquer l'insertion du code
voici le code du module :
j'ai aussi un autre probleme, via la macro Archiver je copie la feuille dans un nouveau classeur, tout est impec sauf la zone d'impression de la feuille générée, et pourtant il parait bien fait
je dois passer par une mise en page
des idées svp
j'ai encore deux ptits problemes :
afficher automatiquement une bordure sous le dernier produit entré et sous les 3 cellules à coté, exemple :
j'entre dans D24 un produit une bordure (*) s'affiche sous D24, E24, F24 et G24 . Si j'entre un deusième produit dans D25 la bordure (*) s'affiche dans D25, E25, F25 et G25 en s'enlevant de D24, E24, F24 et G24
le but c'est d'avoir toujours une bordure sous le dernier produit saisi
dans mon fichier la saisie des produits se fait par un click dans une liste ce qui pourrait compliquer l'insertion du code
voici le code du module :
Code:
Public Chemin As String, Nom As String
Public Produit As String, PUht As Currency, dLgFa As Byte, dLgRe As Byte
Public NumFa As String, NumBL As String, NomDoc As String, TypDoc As String
Public FichierModele As String, FichierDocu As String
Public TypFeuil As String
Sub AjoutProduit()
With ActiveSheet
If Not .Range("D24:D42").Find(Produit, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
MsgBox "Ce produit figure déjà dans la liste !", vbOKOnly + vbExclamation, "PRODUIT DÉJÀ ENREGISTRÉ"
Exit Sub
End If
dLgFa = .Range("D43").End(xlUp).Row + 1
If dLgFa = 23 Then dLgFa = 24
.Cells(dLgFa, 4) = Produit
End With
End Sub
Sub ValideProduit()
With ActiveSheet
For Each Cel In .Range("D24:D42")
If Cel.Value = "" Then .Range("E" & Cel.Row & ":F" & Cel.Row) = ""
Next
End With
End Sub
[COLOR="red"]Sub Archiver()[/COLOR]
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim NbFeuilles As Byte
Dim Lg As Long, dLg As Long
' Récupère le nom du classeur modèle
FichierModele = ThisWorkbook.Name
' Définition du nom de fichier en fonction de la feuille renseignée
With ActiveSheet
Select Case .Name
Case Is = "BL HT", Is = "BL TTC", Is = "Fa HT", Is = "Fa TTC"
NomDoc = .Name & .Range("G15")
Case Is = "Fa + BL HT", Is = "Fa + BL TTC"
If .Range("G17") = "" Then
MsgBox "Bon de Livraison non référencé !" & vbCrLf & "Veuillez numéroter ce document", _
vbOKOnly + vbExclamation, "RÉFÉRENCE INCOMPLÈTE"
.Range("G17").Interior.ColorIndex = 3
.Range("G17").Select
Exit Sub
End If
NomDoc = "Fa" & .Range("G15") & " + " & "BL" & .Range("G79")
End Select
End With
'Message de confirmation
rep = MsgBox("Un nouveau fichier nommé '" & NomDoc & "' va être créé !" & vbCrLf & _
"Voulez-vous continuer ?", vbYesNo + vbQuestion, "ENREGISTREMENT " & NomDoc)
If rep = vbNo Then Exit Sub
' Lecture du répertoire actuel
Chemin = ThisWorkbook.Path & "\"
' Lecture du nombre de feuilles par défaut défini dans les options d'Excel
NbFeuilles = Application.SheetsInNewWorkbook
' Définition du nombre d'onglets (ici 1)
Application.SheetsInNewWorkbook = 1
' Ajout du classeur
Set xlBook = Application.Workbooks.Add
' Sauvegarde le classeur sous le nom du document en cours
Application.DisplayAlerts = False
xlBook.SaveAs Chemin & NomDoc
Application.DisplayAlerts = True
' Création de l'onglet dans le nouveau classeur
Set xlSheet = xlBook.Worksheets(1)
' Affecte le nom du classeur à l'onglet
ActiveSheet.Name = NomDoc
ThisWorkbook.Activate
' Copie de la feuille active du classeur modèle
Application.ScreenUpdating = False
ActiveSheet.Cells.Select
Selection.Copy
Range("A20").Select
Windows(2).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
With ActiveWindow
.DisplayGridlines = False
.DisplayZeros = False
End With
' Définitions des paramètres pour l'impression papier
With ActiveSheet.PageSetup
.PrintArea = "$D$1:$G$123"
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A1").Select
' Rétablit le nombre d'onglets par défaut
Application.SheetsInNewWorkbook = 3
End Subj'ai aussi un autre probleme, via la macro Archiver je copie la feuille dans un nouveau classeur, tout est impec sauf la zone d'impression de la feuille générée, et pourtant il parait bien fait
je dois passer par une mise en page
des idées svp
