paperfolder
New Member
- Joined
- Jun 29, 2015
- Messages
- 19
I have the following code which opens all xls file in a folder. Originally I was using printout, however I noticed that if I changed something in printer properties using CTRL+P, the settings did not apply to any of the sheets after page 1. I'm specifically trying to use the three hole punch on left. I tried to send the excel CTRL+P and enter, however that doesn't seem to actually send CTRL+P to the excel application.. it seems to be sending it to my VBA editor? If I can send CTRL+P and enter like a human would in the excel somehow via VBA, I think it would work as I want. I also tried using Application.Dialogs(xlDialogPrint).Show and it also fails to after Page 1.
I cannot change the default printer properties since it can only be changed by the admin.
TLDR - how do I actually send CTRL+P and Enter to excel?
Any help is much appreciated!
I cannot change the default printer properties since it can only be changed by the admin.
TLDR - how do I actually send CTRL+P and Enter to excel?
Any help is much appreciated!
Code:
Public Sub Print_All()
Dim fldr As FileDialog
Dim myFolder As String
Dim myFile As String
Dim myFiles() As String
Dim imax As Integer
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
myFolder = .SelectedItems(1)
End With
NextCode:
PrintAll = myFolder
Set fldr = Nothing
Debug.Print myFolder
myFile = Dir(myFolder & "\*.xlsx")
Dim i As Integer
'aquire name
i = 0
Do While myFile <> ""
If i = 0 Then
ReDim myFiles(i)
Else
ReDim Preserve myFiles(i)
End If
myFiles(i) = myFile
Debug.Print myFiles(i)
i = i + 1
myFile = Dir
Loop
Debug.Print "sorted"
'sorts array
QuickSort myFiles(), LBound(myFiles), UBound(myFiles)
imax = i
' adds additional information
For i = LBound(myFiles) To UBound(myFiles)
j = j + 1
Debug.Print myFiles(i)
Workbooks.Open Filename:=myFolder & "\" & myFiles(i)
Worksheets("Print").Activate
ActiveSheet.PageSetup.LeftHeader = "Page " & CStr(j) & " of " & CStr(imax) 'edit header of sheet
'Application.Dialogs(xlDialogPrint).Show
Application.SendKeys ("^p")
Application.SendKeys ("~")
ActiveWorkbook.Save 'save sheet
ActiveWorkbook.Close 'close sheet
Next i
End Sub
Private Sub QuickSort(strArray() As String, intBottom As Integer, intTop As Integer)
Dim strPivot As String, strTemp As String
Dim intBottomTemp As Integer, intTopTemp As Integer
intBottomTemp = intBottom
intTopTemp = intTop
strPivot = strArray((intBottom + intTop) \ 2)
While (intBottomTemp <= intTopTemp)
' comparison of the values is a descending sort
While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
intBottomTemp = intBottomTemp + 1
Wend
While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
intTopTemp = intTopTemp - 1
Wend
If intBottomTemp < intTopTemp Then
strTemp = strArray(intBottomTemp)
strArray(intBottomTemp) = strArray(intTopTemp)
strArray(intTopTemp) = strTemp
End If
If intBottomTemp <= intTopTemp Then
intBottomTemp = intBottomTemp + 1
intTopTemp = intTopTemp - 1
End If
Wend
'the function calls itself until everything is in good order
If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop
End Sub