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 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
| Option Explicit
Private Sub CommandButton1_Click()
Dim Chemin, nom_fichier_B, classeur_tempo As String
Dim longueur_fichier As Long
Dim nouveau_fichier As String
Dim nom_fichier_source As String
Dim lastlig As Integer
ActiveWorkbook.Save
Chemin = ActiveWorkbook.Path
nom_fichier_source = ActiveWorkbook.Name
longueur_fichier = Len(nom_fichier_source)
Application.DisplayAlerts = False ' supprime les boîtes de dialogues de confirmation d'enregistrement
If Me.OptionButton1.Value = True Then 'si choix Excel
On Error GoTo erreurpdp 'si pas de pdp, alors msg d'erreur et on sort
'définir la dernière ligne de l'offre
lastlig = Range("A:A").Find("pdp", LookIn:=xlFormulas, LookAt:=xlWhole).Row
'définir chemin et nom du nv fichier excel
nom_fichier_B = "B" + Right(nom_fichier_source, longueur_fichier - 1)
nouveau_fichier = Chemin + "\" + nom_fichier_B 'le chemin et le nom du fichier B Budget
Worksheets("Selection").Unprotect 'déprotéger feuille Sélection le temps de la macro
Worksheets("Selection").Copy 'copier l'onglet selection
With ActiveWorkbook 'la coller dans un nv fichier que l'on enregistre selon le nom défini au dessus
.SaveAs Filename:=nouveau_fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End With
Workbooks(nom_fichier_B).Activate
ActiveWorkbook.BreakLink Name:=nom_fichier_source, Type:=xlExcelLinks ' Rompt les liaisons
'copier coller valeurs de l'offre
Range("B4:D" & lastlig).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'afficher les 3 lignes modèle et les supprimer
Rows("1:4").Select
Selection.EntireRow.Hidden = False
Rows("1:3").Select
Selection.Delete Shift:=xlUp
'suppirmer les colonnes à droite de l'offre
Columns("E:Z").Select
Selection.Delete Shift:=xlToLeft
'afficher colonne A et la supprimer
Columns("A:B").Select
Selection.EntireColumn.Hidden = False
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
'enregistrer le fichier
ActiveWorkbook.Save
Unload Me
MsgBox ActiveWorkbook.Name
MsgBox ("Fichier Excel créé.")
Workbooks(nom_fichier_source).Activate 're verrouiller la feuille Selection
Worksheets("Selection").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowDeletingRows:=True, AllowSorting:=True
ElseIf Me.OptionButton2.Value = True Then 'si choix pdf
'définir chemin et nom du nv fichier pdf
nom_fichier_source = Left(nom_fichier_source, longueur_fichier - 5) 'supprimer extension .xlsm
longueur_fichier = Len(nom_fichier_source)
nom_fichier_B = "B" + Right(nom_fichier_source, longueur_fichier - 1)
nouveau_fichier = Chemin + "\" + nom_fichier_B
With Worksheets("Selection") 'enregistré sous pdf et ouvrir le pdf la zone d'impression est définie dans l'excel
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nouveau_fichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
'Workbooks(nom_fichier_source).Activate
Unload Me
MsgBox ("Fichier PDF créé sous : " & Chemin)
Else 'si pas de choix
MsgBox "Vous devez sélectionner un type de fichier."
'Unload Me
Exit Sub
End If
Application.DisplayAlerts = True
Exit Sub
erreurpdp:
MsgBox "Manque la borne ""pdp"" en colonne A. Génération du fichier Excel impossible."
Unload Me
End Sub |
Partager