génération auto et purge document

lily1612

XLDnaute Nouveau
bonjour le forum

je suis novice en la matière et je suis en train de créer un bon de commande que je souhaiterais "automatisé" par des macros.

Aprés des tonnes de recherche sur le net, dans les tutoriels etc je n'arrive pas à régler mes problémes car je ne connais pas grand chose dans le language VBA. votre site m'a été recommandé car grand nombre d'entre vous êtes expert en la matiére et prenez le temps d'expliquer.

Je compte donc sur vous pour m'aider à comprendre cela et si possible me débloquer un peu.

Voici la fonction des macros que je souhaiterais mettre en place:
* réinitialisater le bon de commande ainsi que certaines cellules qui sont sur d'autres feuilles. à savoir que ces dernières sont des quantités saisies et déverouillées
* génération automatique d'un numéro de bon de commande +1 lors de l'enregistrement


voici ma 1ére macro pour enregistrer qui fonctionne mais ne me génére pas de numéro supp

****************************************************************
Sub Enregistrer()

MsgBox "cette Macro va enregistrer le document en cours, voulez-vous continuer?", 1, "Macro Enregistrer & Reset+1"
Dim NomFich As String, WkbC As Workbook, Wkb As Workbook
Application.DisplayAlerts = False
Set Wkb = ActiveWorkbook
With Sheets("ORDER")
.Range("C13").Value = .Range("C13").Value + 1
NomFich = "C" & .Range("C13") & " " & .Range("C14")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Commande\" & NomFich & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With

Set WkbC = Workbooks.Add(xlWBATWorksheet)
Wkb.Sheets("ORDER").Copy Before:=WkbC.Sheets(1)
WkbC.Sheets(2).Delete
WkbC.SaveAs "C:\Commande\" & NomFich & ".xls", xlExcel8
WkbC.Close
Application.DisplayAlerts = True
With Selection.Characters(Start:=1, Length:=5).Font
.Name = "Calibri"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = 2
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub




puis celle pour réinitialiser (qui me purge des lignes mais pas toute celle de mon bon de commande et de mes autres feuilles)
*****************************************************************

Option Explicit
Sub Cadrage()
Dim c As Range
Dim nomf As String
Dim n As Integer
'Sheet ("ORSAY 33 small").Select
With Range("a1:p200")
Set c = .Find("Fin tournée", LookIn:=xlValues, lookat:=xlWhole)
End With

If Not c Is Nothing Then
Range("A" & c.Row + 1 & ":D200").Clear
For n = c.Row + 2 To 200 Step 2
Range("E" & n & ":G" & n).Clear
Next n
End If
nomf = Application.InputBox("Nommez la feuille !", Type:=2)
ActiveSheet.Name = nomf
Range("A1") = nomf
End Sub
Sub Initialisation()
' Initialisation Macro
Dim n As Integer
Dim m As Integer
'Dim monom As String
'monom = ActiveSheet.Name
ActiveSheet.Copy After:=Sheets(Sheets.Count)
Cadrage
m = Range("C65536").End(xlUp).Row
For n = 6 To m + 1 Step 2
Range("E" & n & ":G" & n).Value = ""
Next n
End SubSub INIT()
'
' INIT Macro
'

'
End Sub

ci joint une partie de mon fichier divisé par il ne passe pas dans sa globalité.

merci d'avance pour votre aide
 

Pièces jointes

  • Classeur1.xls
    83.5 KB · Affichages: 71
  • Classeur2.xls
    91.5 KB · Affichages: 50
  • Classeur1.xls
    83.5 KB · Affichages: 61
  • Classeur2.xls
    91.5 KB · Affichages: 54
  • Classeur1.xls
    83.5 KB · Affichages: 71
  • Classeur2.xls
    91.5 KB · Affichages: 64

stefan373

XLDnaute Occasionnel
Bonjour lily1612 et le forum.

Pour incrémenter une cellule de +1, à placer à la fin de votre code. :)


Code:
With Sheets("Feuil1").Range("D1").Select  ' Ici la cellule D1 +1 à adapter pour vous
If IsNumeric(ActiveCell.Value) Then ActiveCell.Value = ActiveCell.Value + 1

A +
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 069
Messages
2 085 037
Membres
102 762
dernier inscrit
Ucef