cjoint

Publicité


Publicité

Format du document : text/plain

Prévisualisation

Option Explicit

Sub Efface()
Const CheckRange = "E23:E40" 'E23:E40 correspond a la plage de cellule que l'on souhaite verifier

Dim Lig, LigDeb, LigFin, Col As Long

Col = ActiveSheet.Range(CheckRange).Column
LigDeb = ActiveSheet.Range(CheckRange).Row
LigFin = LigDeb + ActiveSheet.Range(CheckRange).Cells.Count - 1

MsgBox "Colonne = " & Col & ", Ligne début = " & LigDeb & ", Ligne fin = " & LigFin

Lig = LigDeb
While Lig <= LigFin
MsgBox "Examine cellule " & ActiveSheet.Cells(Lig, Col).Address
If IsEmpty(ActiveSheet.Cells(Lig, Col)) Then
MsgBox "Delete ligne " & Lig
ActiveSheet.Cells(Lig, Col).EntireRow.Delete
LigFin = LigFin - 1
Else
Lig = Lig + 1
End If
Wend

End Sub

Sub Enregistre()
Const ExtensionPDF = ".pdf"
Const ExtensionExcel = ".xlsm"
Const CelluleNomFichier = "B14"
Const RépertoireFichier = "H:\Téléchargements\"

Dim SourceSheet As Worksheet
Dim CheminFichierSansExtension As String
Dim ErrNb As Integer

'Copie colonnes "A:G" de la feuille active sur une nouveau classeur
Set SourceSheet = ActiveSheet
Workbooks.Add
SourceSheet.Columns("A:G").Copy ActiveSheet.Columns("A:G")

'Nom complet du fichier à enregistrer sans l'extension
If Len(ActiveSheet.Range(CelluleNomFichier).Value) > 0 Then
CheminFichierSansExtension = RépertoireFichier & ActiveSheet.Range(CelluleNomFichier).Value
Else
MsgBox "Cellule " & ActiveWorkbook.Name & "." & ActiveSheet.Name & _
".Range(" & ActiveSheet.Range(CelluleNomFichier).Address & ") ne contient pas le nom du fichier"
Exit Sub
End If

'Save du fichier en pdf
On Error Resume Next
ErrNb = 0

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=CheminFichierSansExtension & ExtensionPDF, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ErrNb = Err.Number
On Error GoTo 0

'Gestion de l'erreur
If ErrNb <> 0 Then
MsgBox "Erreur " & ErrNb & " en création du fichier <" & CheminFichierSansExtension & ExtensionPDF & ">"
Else
MsgBox "Le fichier <" & CheminFichierSansExtension & ExtensionPDF & "> a été créé !"
End If

'Save du fichier en Excel
On Error Resume Next
ErrNb = 0

Application.DisplayAlerts = False
'Fichier Excel avec des macros (.xlsm)
ActiveWorkbook.SaveAs Filename:=CheminFichierSansExtension & ExtensionExcel, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Fichier Excel sans macros (.xlsx)
'ActiveWorkbook.SaveAs Filename:=CheminFichierSansExtension & ExtensionExcel, _
' FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
ErrNb = Err.Number
On Error GoTo 0

'Gestion de l'erreur
If ErrNb <> 0 Then
MsgBox "Erreur " & ErrNb & " en création du fichier <" & CheminFichierSansExtension & ExtensionExcel & ">"
Else
MsgBox "Le fichier <" & CheminFichierSansExtension & ExtensionExcel & "> a été créé !"
End If

ActiveWindow.Close
End Sub

Publicité


Signaler le contenu de ce document

Publicité