I'm wondering if a genius amongst us could help me out!
I've created a macro that auto populates a PDF document (essentially customer information) which works fine, but I want to go one step further and make it 'tick' a number of checkboxes depending on a cell entry.
At the moment it checks the first box absolutely fine using
Application.SendKeys "{Tab}", True
Application.SendKeys "~", True
But I essentially want it to continue checking the boxes, based on a particular cell entry (Column 'Bags Destroyed'). So for the below customer, it would continue ticking 12 boxes in total, then 5 for the next customer etc.
To give you some background, we're a charity that deals with paper shredding, and this document will be used to sign off each job (amount of bags we've collected from customer) once the paper has been shred successfully. We use this for audit trail, and have always used paper copies - finally we're looking at catching up with technology!
batch id screenshot.png
batch id auto screenshot.png
Here's the full macro;
Option Explicit
Sub PDFTemplate()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFilePicker)
With PDFFldr
.Title = "Select PDF file to attach"
.Filters.Add "PDF Type Files", "*.pdf", 1
If .Show <> -1 Then GoTo NoSelection
Sheet1.Range("s2").Value = .SelectedItems(1)
End With
NoSelection:
End Sub
Sub SavePDFFolder()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFolderPicker)
With PDFFldr
.Title = "Select a Folder"
If .Show <> -1 Then GoTo NoSel:
Sheet1.Range("s4").Value = .SelectedItems(1)
End With
NoSel:
End Sub
Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, Company, Refno As String
Dim ApptDate As Date
Dim CustRow, LastRow As Long
With Sheet1
If .Range("s2").Value = Empty Or .Range("s4").Value = Empty Then
MsgBox "Both PDF Template and Saved PDF Locations are required for macro to run"
Exit Sub
End If
LastRow = .Range("E9999").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("s2").Value 'Template File Name
SavePDFFolder = .Range("s4").Value 'Save PDF Folder
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00002
For CustRow = 5 To 5
Refno = .Range("E" & CustRow).Value 'Ref No
Company = .Range("F" & CustRow).Value 'Company
Application.SendKeys "{Tab}", True
Application.SendKeys Company, True 'company
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys .Range("E" & CustRow).Value, True 'Ref No
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys .Range("o" & CustRow).Value, True 'Collection Date
Application.Wait Now + 0.00002
Application.SendKeys "{Tab 6}", True
Application.SendKeys "~", True
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys "+^(s)", True
Application.Wait Now + 0.00003
Application.SendKeys "keydown = 13"
Application.Wait Now + 0.00006
Application.SendKeys "%(n)", True
Application.Wait Now + 0.00003
Application.SendKeys SavePDFFolder & "\" & Company & "_" & Refno & "_" & "BATCHID" & ".pdf"
Application.Wait Now + 0.00006
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00006
Next CustRow
Application.Wait Now + 0.00004
Application.SendKeys "^(q)", True
Application.SendKeys "{tab}", True
Application.SendKeys "{Enter}", True
Application.SendKeys "{numlock}%s", True
Application.Wait Now + 0.00003
Application.Speech.Speak "BATCH ID TICKETS HAVE NOW BEEN GENERATED"
End With
End Sub
Appreciate any help on this, thanks in advance!!
Bookmarks