Scribd Logo
Upload

Welcome to Scribd!

  • 10 views

    Azeazrazr

    Uploaded by

    fares arfaoui
    gdgsd

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd

    Azeazrazr

    Uploaded by

    fares arfaoui
    10 views3 pages
    gdgsd

    Original Title

    azeazrazr

    Copyright

    © © All Rights Reserved

    Available Formats

    TXT, PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    gdgsd

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    10 views3 pages

    Azeazrazr

    Uploaded by

    fares arfaoui
    gdgsd

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    You are on page 1of 3

    Sub enregistrerpdf()

    ActiveWorkbook.Save

    'test nom fichier


    sheets(1).Select
    Dim a, b, c, d As String
    Dim m As Long
    a = Cells(4, 5) 'nom fichier excel INFRAPOLE
    b = Cells(5, 5) 'nom fichier excel BTE
    c = Cells(7, 5) 'nom fichier pdf INFRAPOLE
    d = Cells(8, 5) 'nom fichier pdf BTE

    Dim nompdf As String


    Dim nomxlsx As String
    Dim dossier As String

    dossier = ThisWorkbook.Path

    nomxlsx = dossier & "\" & a & "(sans formule)"


    nompdf_INFRAPOLE = dossier & "\" & c
    nompdf_BTE = dossier & "\" & d
    ' ActiveWorkbook.SaveAs Filename:=nomxlsx, FileFormat:= _
    ' xlOpenXMLWorkbook, CreateBackup:=False 'enregistre au format .xlsx

    sheets("TABLEAU").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf_INFRAPOLE &
    ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True,
    IgnorePrintAreas:=False, OpenAfterPublish:=True
    sheets("BTE").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf_BTE & ".pdf",
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,
    OpenAfterPublish:=True
    sheets("TABLEAU").Select
    Cells(1, 1).Select
    End Sub

    Sub exportxlsxandpdfV2()

    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With

    Call enregistrerpdf

    Dim DerniereLigneUtilisee As Long


    Dim Source As String
    Dim Destination As String
    Source = ThisWorkbook.Path & Application.PathSeparator & "Diag entraxe ENT_242-
    5_242-7_PK228108-228526_ind0_INFRAPOLE.xlsm"
    dossier = ThisWorkbook.Path & Application.PathSeparator & "Diag entraxe ENT_242-
    5_242-7_PK228108-228526_ind0_INFRAPOLE.xlsx"
    Workbooks.Add.SaveAs Filename:=dossier
    Source = "Diag entraxe ENT_242-5_242-7_PK228108-228526_ind0_INFRAPOLE.xlsm"
    Destination = "Diag entraxe ENT_242-5_242-7_PK228108-228526_ind0_INFRAPOLE.xlsx"

    Dim sheets As Variant


    ReDim sheets(4)
    sheets(0) = "INPUT"
    sheets(1) = "Tableau"
    sheets(2) = "BTE"
    sheets(3) = "Convention"

    Dim i As Variant
    For i = 1 To UBound(sheets)

    Workbooks(Source).Unprotect ("systra1")
    Workbooks(Destination).Unprotect ("systra1")
    Workbooks(Source).sheets(i).Unprotect ("systra1")
    Workbooks(Source).sheets(i).Copy Workbooks(Destination).sheets(i)

    Workbooks(Destination).sheets(i).Activate
    Workbooks(Destination).sheets(i).UsedRange.Select

    Workbooks(Source).sheets(i).Unprotect ("systra1")

    Workbooks(Destination).sheets(i).UsedRange.Value =
    Workbooks(Destination).sheets(i).UsedRange.Value
    Workbooks(Source).Protect ("systra1")
    Workbooks(Destination).Protect ("systra1")

    Next i

    Workbooks(Source).Unprotect ("systra1")
    Workbooks(Destination).Unprotect ("systra1")

    Call deleteinutile

    Workbooks(Destination).sheets(1).Select
    ActiveWindow.SelectedSheets.Delete
    Workbooks(Destination).sheets(2).Select
    ActiveWindow.SelectedSheets.Delete

    Workbooks(Source).Protect ("systra1")
    'Workbooks(Destination).Protect ("systra1")

    Workbooks(Source).sheets("TABLEAU").Protect ("systra1")
    'Workbooks(Destination).sheets("TABLEAU").Protect ("systra1")
    'Workbooks(Destination).sheets("BTE").Protect ("systra1")

    Workbooks(Destination).Save

    End Sub

    Sub deleteinutile()

    Dim DerniereLigneUtilisee As Long


    Dim DerniereLigneUtilisee1 As Long
    Dim Destination As String
    Destination = "Diag entraxe ENT_242-5_242-7_PK228108-228526_ind0_INFRAPOLE.xlsx"

    Workbooks(Destination).sheets(2).Select
    DerniereLigneUtilisee = Range("X" & Rows.Count).End(xlUp).Row
    Range(Rows(29), Rows(DerniereLigneUtilisee)).Select
    Selection.Delete
    Range("AC:DG").Select
    Selection.Delete

    Workbooks(Destination).sheets(3).Unprotect ("systra1")

    Workbooks(Destination).sheets(3).Select
    DerniereLigneUtilisee1 = Range("X" & Rows.Count).End(xlUp).Row
    Range(Rows(487), Rows(DerniereLigneUtilisee)).Select
    Selection.Delete

    End Sub

    You might also like