I have a form that I have developed in Excel and added a command button to print the form. There are four pages to the form, but if the first cell of the second or third pages of the cell are blank, I want to skip those pages. I have come up with the following code, but i get an "Type Mismatch" error as it combines the ranges. Is this not an appropriate way to combine ranges/ is there a better way?
Private Sub PrintAuth1_Click()
' Prints the Authorization Form upon clicking once
Dim printrng As Range 'Range to be printed so that blank pages are not printed.
Set printrng = Worksheets("BLR 13210").Range("A1:AX69")
Dim ws As Worksheet
Set ws = ActiveSheet
If ws.Range("E75") <> "" Then 'If first line of this page is blank, then it won't print the page
printrng = printrng & ws.Range("A70:AX135")
End If
If ws.Range("E141") <> "" Then 'If first line of this page is blank, then it won't print the page
printrng = printrng & ws.Range("A136:AX200")
End If
printrng = printrng & ws.Range("A201:AX264") 'Adds last page to print range
' Dialog Box to decide whether to quick print or make changes to printer setup.
msg = "Would you like to send to default printer?"
msg = msg & vbNewLine
config = vbYesNoCancel + vbQuestion + vbDefaultButton1
Title = "Printer Selection"
ans = MsgBox(msg, config, Title)
If ans = vbYes Then printrng.PrintOut Copies:=1, Collate:=True
If ans = vbNo Then Application.Dialogs(xlDialogPrint).Show
If ans = vbCancel Then
End If
End Sub
Related
I have this code from another website but it's not working.
I want to filter the split view form from another form.
Private Sub btnSearch_Click()
'//Check that other form is loaded - if not, then open it
If Not fIsLoaded("frmMain") Then
DoCmd.OpenForm ("frmMain")
End If
'//Set filter to listbox criterion
Forms("frmMain").Filter = "[Priorities] = " & Chr(34) & Me.Priorities & Chr(34)
Forms("frmMain").FilterOn = True
End Sub
Function fIsLoaded(ByVal strFormname As String) As Boolean
'Returns False if form is not open or True if Open
If SysCmd(acSysCmdGetObjectState, acForm, strFormname) <> 0 Then
If Forms(strFormname).CurrentView <> 0 Then
fIsLoaded = True
End If
End If
End Function
I received this error
My best guess is the form wasn't ready to take a filter yet, and that's why the error occurred. DoCmd.OpenForm takes a Where argument to set the filter when opening to prevent this from occuring.
Private Sub btnSearch_Click()
'//Check that other form is loaded - if not, then open it with the filter
If Not fIsLoaded("frmMain") Then
DoCmd.OpenForm ("frmMain",,,"[Priorities] = " & Chr(34) & Me.Priorities & Chr(34))
Else
'//Set filter to listbox criterion
Forms("frmMain").Filter = "[Priorities] = " & Chr(34) & Me.Priorities & Chr(34)
Forms("frmMain").FilterOn = True
End If
End Sub
Check if this works. If not, your filter might not be valid for that form.
objJSO.GetField(strField).Value = (strFieldVal) - That is the line I'm recieving a 'type mismatch' error on.
I've found the code base from "My Engineering World". It is an old post.
I'm selecting a static PDF form and trying to write values from an excel doc to the PDF form which contains the same field names. The excel doc has the field names in column c20-149 with the values for those fields in d20-149. I'm trying to write the values for those fields into the selected PDF form.
Option Explicit
Sub btnToPDF_Click()
Dim objAcroApp As Object
Dim objAcroAVDoc As Object
Dim objAcroPDDoc As Object
Dim objJSO As Object
Dim fd As Office.FileDialog
Dim strFile As String
Dim strField As String
Dim strFieldVal As String 'Used to hold the field value
Dim r As Long 'Used to increase row number for strfield name
'Disable screen flickering.
Application.ScreenUpdating = False
'Choose the Onsite Survey form you want to fill
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the On-site survey PDF."
.Filters.Clear
.Filters.Add "PDF", "*.PDF"
'.Filters.Add "All Files", "*.*"
'If the .Show method returns False, the user clicked Cancel.
If .Show = True Then
strFile = .SelectedItems(1)
MsgBox (strFile)
End If
End With
'Initialize Acrobat by creating the App object.
Set objAcroApp = CreateObject("AcroExch.App")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the App object!", vbCritical, "Object error"
'Release the object and exit.
Set objAcroApp = Nothing
Exit Sub
End If
'Create the AVDoc object.
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
'Release the objects and exit.
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If
On Error GoTo 0
'Open the PDF file.
If objAcroAVDoc.Open(strFile, "") = True Then
'Set the PDDoc object.
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
'Set the JS Object - Java Script Object.
Set objJSO = objAcroPDDoc.GetJSObject
On Error GoTo 0
'Fill the form fields.
For r = 20 To 149
strField = Cells(r, 3)
strFieldVal = Cells(r, 4)
objJSO.GetField(strField).Value = CStr(strFieldVal)
If Err.Number <> 0 Then
'Close the form without saving the changes.
objAcroAVDoc.Close True
'Close the Acrobat application.
objAcroApp.Exit
'Inform the user about the error.
MsgBox "The field """ & strField & """ could not be found!", vbCritical, "Field error"
'Release the objects and exit.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If
Next r
'Save the form
objAcroPDDoc.Save 1, strFile
'Close the form without saving the changes.
'objAcroAVDoc.Close True
'Close the Acrobat application.
objAcroApp.Exit
'Release the objects.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that forms were filled.
MsgBox "All forms were created successfully!", vbInformation, "Finished"
End If
MsgBox "Something bad happend :(...."
End Sub
OK... found my problem but I'm not sure how to trap the problem. I may not need to as I'm hoping I won't run into this problem. Hoping isn't the best strategy though... :)
My PDF form has fields of type numeric. All my test data in my value cells were alpha-numeric. Once I changed my quantity and cost cells to numeric values in my excel doc the form was written correctly.
Perhaps I can test for the PDF form field type. If it is numeric I'll log the field name and present a msgbox at the end of the operation that displays fields that could not be filled.
I did need to correct my objJSO line to '=strFieldVal'
I'm fairly certain you want...
strField = Cells(r, 3).Value
strFieldVal = Cells(r, 4).Value
objJSO.GetField(strField).Value = strFieldVal
...instead of the three corresponding lines you have.
Below is my final code. It includes basic error handling (more like logging). One problem I did have in this; If I was writing an alpha numeric string to the PDF field and the PDF field was numeric AND there wasn't a default value in the PDF field the PDF would throw and error that my code couldn't catch. As long as there was a default value in the PDF numeric field the error handler worked as planned. Feel free to make any comments. I'm guessing this looks like kindergarten work (maybe 1st grade??)
`Option Explicit
Sub btnToPDF_Click()
Dim objAcroApp As Object
Dim objAcroAVDoc As Object
Dim objAcroPDDoc As Object
Dim objJSO As Object
Dim fd As Office.FileDialog
Dim myWB As Workbook
Set myWB = ThisWorkbook
Dim ToPDFsh As Worksheet
Set ToPDFsh = myWB.Sheets("OSSDataDump")
Dim strFile As String
Dim strField As String
Dim strFieldVal As String 'Used to hold the field value
Dim msgFail As String
Dim colVal As Variant
Dim r As Integer 'Used to increase row number for strfield name
Dim e As Integer 'Used to track the number of errors
Dim colFail As Collection
Set colFail = New Collection
e = 0
'Disable screen flickering.
Application.ScreenUpdating = False
'Choose the Onsite Survey form you want to fill
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the On-site survey PDF."
.Filters.Clear
.Filters.Add "PDF", "*.PDF"
'If the .Show method returns False, the user clicked Cancel.
If .Show = True Then
strFile = .SelectedItems(1)
End If
End With
'Initialize Acrobat by creating the App object.
Set objAcroApp = CreateObject("AcroExch.App")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the App object!", vbCritical, "Object error"
'Release the object and exit.
Set objAcroApp = Nothing
Exit Sub
End If
'Create the AVDoc object.
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
'Release the objects and exit.
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If
'Open the PDF file.
If objAcroAVDoc.Open(strFile, "") = True Then
'Set the PDDoc object.
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
'Set the JS Object - Java Script Object.
Set objJSO = objAcroPDDoc.GetJSObject
'Fill the form fields.
For r = 20 To 149
strField = ToPDFsh.Cells(r, 3).Value
strFieldVal = ToPDFsh.Cells(r, 4).Value
If strFieldVal = "" Then GoTo BlankVal
objJSO.GetField(strField).Value = strFieldVal
On Error GoTo ErrHandler
BlankVal:
Next r
'Save the form
objAcroPDDoc.Save 1, strFile
'Close the form without saving the changes.
'objAcroAVDoc.Close True
'Close the Acrobat application.
objAcroApp.Exit
'Release the objects.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that forms were filled.
If e <> 0 Then
For Each colVal In colFail
msgFail = msgFail & colVal & vbNewLine
Next colVal
MsgBox "Not all fields were filled" & vbNewLine & "The follwoing fields failed:" & vbNewLine & msgFail, vbExclamation, "Finished"
Exit Sub
End If
MsgBox "On site survey was filled successfully!", vbInformation, "Finished"
End If
Exit Sub
ErrHandler:
e = e + 1
If e > 7 Then
MsgBox "Something Bad happend... :(" & vbNewLine & "Form not filled", vbCritical, "Failed"
GoTo ErrHandlerExit
End If
colFail.Add strField
Resume Next
Exit Sub
ErrHandlerExit:
'Close the form without saving the changes.
objAcroAVDoc.Close True
'Close the Acrobat application.
objAcroApp.Exit
'Release the objects and exit.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
'Enable the screen.
Application.ScreenUpdating = True
Exit Sub
End Sub`
I have a form with 3 buttons:
Save - which saves the form
NewReport - which becomes visible only after current form is saved and is supposed to clear the form and let the user input another form of data.
Close - which should close the application without saving the unfinished form.
I cannot seem to figure out how to control these functions using the Before Update event procedure.
One of the things that I do not understand is that the Save command doesn't actually wright the data to the table until I somehow change the focus of the form. So if my user is entering data and hits the Save button, at the completion of the save command, the table does not yet have the data saved. It only appears in the table after focus changes; like from a Requery.
Here is my code in its current version:
Option Compare Database
Option Explicit
Private Cause As Variant
Private Sub btnClose_Click()
Cause = "CloseButton"
DoCmd.Close acForm, "frmReports", acSaveNo
End Sub
Private Sub btnNewReport_Click()
Cause = "NewReport"
Me.Requery
Me.RepStatus = ""
End Sub
Private Sub cmdSave_Click()
Dim outl As Outlook.Application
Dim mi As Outlook.MailItem
'blnGood = True
Cause = "SaveButton"
'Save the Record
DoCmd.Save acForm, "frmReports"
' If Me.DateOfVisit <> "" Then
Me.RepStatus = "Report Saved!"
' Set outl = New Outlook.Application
' Set mi = outl.CreateItem(olMailItem)
' mi.Body = "A new report was just recorded."
' mi.Subject = Application.CurrentUser & " Just Logged a Report."
' mi.To = "rich.temen#cox.net"
' mi.Send
'
' Set mi = Nothing
' Set outl = Nothing
' End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim strMsg As String
Select Case Cause
Case "SaveButton"
Me.btnNewReport.Visible = True
'do nothing
Case "NewReport"
'di this
Case "CloseButton"
Me.Undo
End Select
'If Not blnGood Then
' strMsg = "Please use the Save button to save your Report," & _
' vbNewLine & "or Escape to reset the form."
' Call MsgBox(Prompt:=strMsg, Title:="Before Update")
'End If
End Sub
Private Sub Form_Load()
Me.btnNewReport.Visible = False
Cause = ""
End Sub
Thanks for any help on this one, I have been going around in circles for hours.
Rich
I'm reasonably proficient with Excel VBA (with lots of online help!!) ... but I've stumbled into a problem that has me completely stumped.
I'm creating a Gantt Chart for project planning. My problem is that I wish to have the user specify a project start date and a project end date then have the spreadsheet populate columns from the start date to the end date.
See basic layout:
I have already bottomed out the User Input with InputBoxes
Sub Set_Project_Start_Date()
' Written 2nd August 13
' P.J. Callaghan
'
ActiveSheet.Select
Dim projStartDate
showInputBox_Start:
projStartDate = Application.InputBox("Please enter Project Start Date" & Chr(10) & "Must be a Monday" & Chr(10) & "Format is: dd/mm/yyyy")
' Set Message Box such that clicking cancel ends the sub-routine for projStartdate variable
If projStartDate = False Then
MsgBox "You clicked the Cancel button, Input Box will close.", 64, "Cancel was clicked."
Exit Sub
ElseIf projStartDate = "" Then
MsgBox "You must click Cancel to exit.", 48, "You clicked Ok but entered nothing."
GoTo showInputBox_Start
Else
MsgBox "You entered " & projStartDate & ".", 64, "Please click OK to resume."
Range("c6").Select
With Selection
.Value = projStartDate
.NumberFormat = "dd-mmm-yy"
End With
Range("e10").Select
With Selection
.Value = projStartDate
.NumberFormat = "dd-mmm-yy"
.Orientation = 90
End With
End If
End Sub
Sub Set_Project_End_Date()
' Written 2nd August 13
' P.J. Callaghan
'
ActiveSheet.Select
Dim projEndDate
showInputBox_End:
projEndDate = Application.InputBox("Please enter Project End Date" & Chr(10) & "Must be a Monday" & Chr(10) & "Format is: dd/mm/yyyy")
' Set Message Box such that clicking cancel ends the sub-routine for projStartdate variable
If projEndDate = False Then
MsgBox "You clicked the Cancel button, Input Box will close.", 64, "Cancel was clicked."
Exit Sub
ElseIf projEndDate = "" Then
MsgBox "You must click Cancel to exit.", 48, "You clicked Ok but entered nothing."
GoTo showInputBox_End
Else
MsgBox "You entered " & projEndDate & ".", 64, "Please click OK to resume."
Range("c7").Select
With Selection
.Value = projEndDate
.NumberFormat = "dd-mmm-yy"
End With
End If
End Sub
The bit I'm stuck with is writing code to populate from the start date to the end date only. I'm sure this must be some sort of loop arrangement ... as yet I haven't figured it out.
I wondered if any of you guys could suggest a solution?
Thanks in advance,
Paul
If your goal is to populate the row that starts with cell E10 with daily dates from the start date to the end date of the project, then you can use AutoFill:
With Worksheets("Gantt")
Set sourceRange = .Range("E10")
sourceRange.Value = projStartDate
Set fillRange = .Range(sourceRange, Cells(sourceRange.Row, _
sourceRange.Column + projEndDate - projStartDate + 1))
sourceRange.AutoFill Destination:=fillRange, Type:=xlFillDays
End With
Chuff, that's right on the money.
I've taken your code and modified it slightly ... for some reason it didn't execute as a copy and paste
Sub Date_Fill()
' http://stackoverflow.com/questions/18043084/excel-populate-columns-with-dates-based-on-user-input
Dim projEndDate As Date
Dim projStartDate As Date
Dim projDuration As Integer
projStartDate = Range("c6").Value
projEndDate = Range("c7").Value
With Worksheets("Gantt")
Set SourceRange = .Range("E10")
SourceRange.Value = projStartDate
Set fillRange = .Range(SourceRange, Cells(SourceRange.Row, _
SourceRange.Column + projEndDate - projStartDate + 1))
SourceRange.AutoFill Destination:=fillRange, Type:=xlFillDays
End With
End Sub
Thank you ever so much for your assistance ... this one has been bugging me for a few weeks now. I was looking into loops today as I thought the answer may lie there.
Once again ... many thanks.
I've been working on this for 2 days. Basically I have 2 ListBoxes and I want a command button to compare the values and show the non-matching values (those that appear in the first listbox but not in the 2nd) and list them in the 3rd listbox. I'm not sure if this is the best way to go about it but here's my code. It errors on the line with the message:
Wrong number of arguments or invalid property assignment
My listboxes are named CompList1, CompList2 and CompList3.
Dim BoolAdd As Boolean, I As Long, j As Long
'Set initial Flag
BoolAdd = True
'If CompList2 is empty then abort operation
If CompList2.ListCount = 0 Then
MsgBox "Nothing to compare"
Exit Sub
'If CompList1 is empty then copy entire CompList2 to CompList3
ElseIf CompList1.ListCount = 0 Then
For I = 0 To CompList2.ListCount
CompList3.AddItem CompList2.Value
Next I
Else
For I = CompList2.ListCount - 1 To 0 Step -1
For j = 0 To CompList1.ListCount
If CompList2.ListCount(I) = CompList1.ListCount(j) Then
'If match found then abort
BoolAdd = False
Exit For
End If
DoEvents
Next j
'If not found then add to CompList3
If BoolAdd = True Then CompList3.AddItem CompList2.Value
DoEvents
Next I
End If
Some notes:
Dim tdf1 As TableDef
Dim tdf2 As TableDef
Dim db As Database
Set db = CurrentDb
Set tdf1 = db.TableDefs(Me.CompList1.RowSource)
For Each fld In tdf1.Fields
sFields = sFields & ";" & fld.Name
Next
sFields = sFields & ";"
Set tdf2 = db.TableDefs(Me.CompList2.RowSource)
For Each fld In tdf2.Fields
sf = ";" & fld.Name & ";"
sFields = Replace(sFields, sf, ";")
Next
Me.CompList3.RowSource = Mid(sFields,2)
Edit: