简体   繁体   中英

Looping to save a range as a pdf file in a new folder created in the current directory

I want to save a range of an excel sheet into a pdf file in a new folder created automatically in the current directory (I need to do the same for all excel sheets in the documents) But each time I run the code there's no file saved or a folder created on my desktop ( the excel file on which I'm working is located in the desktop)
I will be grateful for your help Thanks here's the function that I wrote

Sub PDF_saving()
    
    Dim tbAllBoxes() As Variant
        'Put all you textboxes into an array
        tbAllBoxes = Array(SuiviConso.Controls("Textbox2"), SuiviConso.Controls("Textbox3"), SuiviConso.Controls("Textbox4"), SuiviConso.Controls("Textbox5"), SuiviConso.Controls("Textbox6"), SuiviConso.Controls("Textbox7"), SuiviConso.Controls("Textbox8"), SuiviConso.Controls("Textbox9"))
        Dim tballLabels() As Variant
        tballLabels = Array(SuiviConso.Controls("Label2"), SuiviConso.Controls("Label3"), SuiviConso.Controls("Label4"), SuiviConso.Controls("Label5"), SuiviConso.Controls("Label6"), SuiviConso.Controls("Label7"), SuiviConso.Controls("Label8"), SuiviConso.Controls("Label9"))
        Dim shAllSheets As Variant
        'Put all your worksheets into an array
        shAllSheets = Array(ThisWorkbook.Sheets("sheet2"), ThisWorkbook.Sheets("sheet3"), ThisWorkbook.Sheets("sheet4"), ThisWorkbook.Sheets("sheet5"), ThisWorkbook.Sheets("sheet6"), ThisWorkbook.Sheets("sheet7"), ThisWorkbook.Sheets("sheet8"), ThisWorkbook.Sheets("sheet9"))
    
    Dim wbA As Workbook
    Dim lastrow2 As Integer
    Dim strPath, path  As String
    Dim filename As String
    Dim rng As Range
    
    
    For i = 1 To UBound(shAllSheets)
        If tbAllBoxes(i).Value <> "" Then
    filename = shAllSheets(i).Range("A1").Value & Format(Date, "MM-DD-YYYY") & " rapport de consommation " & ".pdf"
    strPath = path & filename
    MkDir strPath
    lastrow2 = shAllSheets(i).Range("A" & Rows.Count).End(xlUp).Row + 1
    Set rng = shAllSheets(i).Range("A1 : J" & lastrow2)
    rng.ExportAsFixedFormat Type:=xlTypePDF, filename:=ActiveWorkbook.path & filename
    End If
    Next i
    End Sub
  1. Open your macro
  2. Park on the line For i = 1 To UBound(shAllSheets)
  3. Press 'F9', a red bullet will apprear before this line (=breakpoint)
  4. Run your macro, it will break at the line with the breakpoint
  5. Use 'F8' and other options from the 'Debug' menu to see what your code does do.

With every step (after pressing 'F8') think about what happened, and why it did happen. What variables are changed, and if they are updated do they have the value that you expect them to have?

After having this done several times you should have a better knowledge about the working of your macro, which makes it possible to ask a better question about this macro.

Suc6 with debugging!

@ Luuk & @TimWilliams, I tried what you told me I'm really thankful and grateful now folders are created & pdf files are generated but the files are not included in the folders

Dim tbAllBoxes() As Variant
    'Put all you textboxes into an array
    tbAllBoxes = Array(SuiviConso.Controls("Textbox2"), SuiviConso.Controls("Textbox3"), SuiviConso.Controls("Textbox4"), SuiviConso.Controls("Textbox5"), SuiviConso.Controls("Textbox6"), SuiviConso.Controls("Textbox7"), SuiviConso.Controls("Textbox8"), SuiviConso.Controls("Textbox9"))
    Dim tballLabels() As Variant
    tballLabels = Array(SuiviConso.Controls("Label2"), SuiviConso.Controls("Label3"), SuiviConso.Controls("Label4"), SuiviConso.Controls("Label5"), SuiviConso.Controls("Label6"), SuiviConso.Controls("Label7"), SuiviConso.Controls("Label8"), SuiviConso.Controls("Label9"))
    Dim shAllSheets As Variant
    'Put all your worksheets into an array
    shAllSheets = Array(ThisWorkbook.Sheets("sheet2"), ThisWorkbook.Sheets("sheet3"), ThisWorkbook.Sheets("sheet4"), ThisWorkbook.Sheets("sheet5"), ThisWorkbook.Sheets("sheet6"), ThisWorkbook.Sheets("sheet7"), ThisWorkbook.Sheets("sheet8"), ThisWorkbook.Sheets("sheet9"))

Dim wbA As Workbook
Dim lastrow2 As Integer
Dim strPath, path  As String
Dim filename As String
Dim rng As Range
Dim fsoFSO

path = ActiveWorkbook.path & "/" & "/rapport de consommation"

For i = 1 To UBound(shAllSheets)
    'If tbAllBoxes(i).Value <> "" Then
filename = shAllSheets(i).Range("A1").Value '& Format(Date) '& " rapport de consommation" '& ".pdf"

strPath = path & filename

Set fsoFSO = CreateObject("Scripting.FileSystemObject")
If fsoFSO.FolderExists(strPath) Then
    MsgBox "found it"
Else
    fsoFSO.CreateFolder (strPath)
    MsgBox "Done"
End If
lastrow2 = shAllSheets(i).Range("A" & Rows.Count).End(xlUp).Row + 1
Set rng = shAllSheets(i).Range("A1 : J" & lastrow2)
rng.ExportAsFixedFormat Type:=xlTypePDF, filename:=strPath
'End If
Next i
End Sub

Something like this:

    Set FSO = CreateObject("scripting.filesystemobject")

    basepath = ActiveWorkbook.path & "/rapport de consommation/"

    For i = 1 To UBound(shAllSheets)
        
        filename = shAllSheets(i).Range("A1").Value
        folderPath = basepath & filename
        If Not FSO.folderexists(folderPath) Then FSO.createfolder (folderPath)
        
        With shAllSheets(i)
            .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).ExportAsFixedFormat _
                                Type:=xlTypePDF, _
                                filename:=folderPath & "\" & filename & ".pdf"
        End With
    Next i

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM