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 31 32 33 34 35 36 37
| Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Public Function ChDirNet(szPath As String) As Boolean
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function
Function GetDateFormatUS(d As Date) As String
GetDateFormatUS = Evaluate("TEXT(" & CLng(d) & ",""dd-mmm-yyyy"")")
End Function
Sub Save_Print()
Dim Customer, today, FName As String
Dim CT As String * 6
Dim Tri As String * 3
Dim nbColis As Integer
today = GetDateFormatUS(Now()) 'Date au Format US
Customer = Worksheets("DO_FR").Range("E10") 'Récupère nom du Projet
CT = Right(Worksheets("Shipping").Range("C7"), 6) 'Récupère la fin du N° de requête
Tri = WorksheetFunction.VLookup(Range("E47").Value, Worksheets("Contacts").Range("C2:J8"), 8, False) 'Récupère le Trigramme
FName = ("Delivery Order " & Customer & " (" & CT & ") " & StrConv(today, vbUpperCase) & Chr(160) & Tri) 'Concatène les infos pour avoir le nom de fichier
nbColis = WorksheetFunction.Sum(Range("E20:E38")) 'Prépare le nombre d'impression n+2
ChDirNet "\\RNS01\Dept\Cso\itso\COS\Facilities\Security Activity\Expedition"
'ChDirNet "H:\Facilities\Security Activity\Expedition"
Application.Dialogs(xlDialogSaveAs).Show (FName & ".xlsm") 'Enregistre avec nom préformaté
'ActiveWindow.SelectedSheets.PrintOut Copies:=nbColis + 2, Collate:=True, IgnorePrintAreas:=False 'Imprime n+2 fois
FNameFull = "'" & FName & ".xlsm" & "'"
MsgBox (FNameFull & " a été enregistré et imprimé " & nbColis + 2 & " fois")
End Sub |
Partager