Scribd
Upload
13 views2 pages

VBA

The document is a VBA macro that generates PDF files from multiple worksheets in an Excel workbook for a range of serial numbers from 1 to 1000. It exports data from specified sheets such as 'Route CardNew', 'FINAL qc', 'SOLDERABLITY TEST', 'THERMAL STRESS TEST', and 'E-TEST REPORT' to designated folders, handling errors and warnings during the process. The macro updates the status bar and displays a message upon completion of the task.

Uploaded by

Deepak Periyasamy
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
13 views2 pages

VBA

The document is a VBA macro that generates PDF files from multiple worksheets in an Excel workbook for a range of serial numbers from 1 to 1000. It exports data from specified sheets such as 'Route CardNew', 'FINAL qc', 'SOLDERABLITY TEST', 'THERMAL STRESS TEST', and 'E-TEST REPORT' to designated folders, handling errors and warnings during the process. The macro updates the status bar and displays a message upon completion of the task.

Uploaded by

Deepak Periyasamy
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

Sub Generate_PDFs_From_Serials_Corrected()

Dim wb As Workbook
Dim routeSheet As Worksheet
Dim finalSheet As Worksheet
Dim solderSheet As Worksheet
Dim thermalSheet As Worksheet
Dim etestSheet As Worksheet
Dim i As Long
Dim fileName As String
Dim roFolder As String
Dim qaFolder As String
Dim solderFolder As String
Dim thermalFolder As String
Dim etestFolder As String

' Set your folders


roFolder = "C:\Users\Dell\OneDrive\Desktop\files\Ro"
qaFolder = "C:\Users\Dell\OneDrive\Desktop\files\Qa"
solderFolder = "C:\Users\Dell\OneDrive\Desktop\files\Qa_SOLDERABLITY TEST"
thermalFolder = "C:\Users\Dell\OneDrive\Desktop\files\Qa_THERMAL STRESS TEST"
etestFolder = "C:\Users\Dell\OneDrive\Desktop\files\Qa_E-TEST REPORT"

Set wb = ThisWorkbook

On Error GoTo ErrorHandler

For i = 1 To 1000
Application.StatusBar = "Processing Serial Number " & i & " of 1000..."
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Set Route CardNew


Set routeSheet = wb.Sheets("Route CardNew")
routeSheet.Range("D6").Value = i

' Force recalculation


Application.Calculate

' Get filename from B7


fileName = Trim(routeSheet.Range("B7").Text)
If fileName = "" Then
Debug.Print "Warning: B7 is empty for serial " & i & ", skipping saving
PDFs..."
GoTo NextIteration
End If

' --- Export PDFs ---


' Route CardNew
routeSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=roFolder & "\" &
fileName & ".pdf"

' FINAL qc
Set finalSheet = wb.Sheets("FINAL qc")
If finalSheet.PageSetup.PrintArea <> "" Then
finalSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=qaFolder &
"\" & fileName & ".pdf"
Else
Debug.Print "Warning: PrintArea not set for FINAL qc for serial " & i
End If

' SOLDERABLITY TEST


Set solderSheet = wb.Sheets("SOLDERABLITY TEST")
If solderSheet.PageSetup.PrintArea <> "" Then
solderSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=solderFolder
& "\" & fileName & ".pdf"
End If

' THERMAL STRESS TEST


Set thermalSheet = wb.Sheets("THERMAL STRESS TEST")
If thermalSheet.PageSetup.PrintArea <> "" Then
thermalSheet.ExportAsFixedFormat Type:=xlTypePDF,
Filename:=thermalFolder & "\" & fileName & ".pdf"
End If

' E-TEST REPORT


Set etestSheet = wb.Sheets("E-TEST REPORT")
If etestSheet.PageSetup.PrintArea <> "" Then
etestSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=etestFolder &
"\" & fileName & ".pdf"
End If

NextIteration:
DoEvents
Next i

CleanExit:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done! 1000 serial numbers processed.", vbInformation
Exit Sub

ErrorHandler:
MsgBox "Error during Serial Number " & i & ": " & Err.Description, vbCritical
Resume Next

End Sub

You might also like