I've tried this code in order to get my form to tell me whether a customer is older than 16 or 18 if they're trying to hire a R16 or R18 movie.
HireMovieID and HireCustomerID are two text boxes on my form. MovieID and CustomerID are columns within my MovieList and CustomerInfo tables.
Private Sub HireCommand_Click()
If Not IsNumeric(HireMovieID) Or Not IsNumeric(HireCustomerID) Then
MsgBox "Error: Not a number"
Exit Sub
End If
Dim MovieRating As String
Dim CustomerDOB As Date
Dim Age16Check As Date
Dim Age18Check As Date
MovieRating = DLookup("[Rating]", "MovieList", "MovieID = [Forms]![HireForm]![HireMovieID]")
CustomerDOB = DLookup("[DOB]", "CustomerInfo", "CustomerID = [Forms]![HireForm]![HireCustomerID]")
Age16Check = DateSerial(-16, Month(Date), Day(Date))
Age18Check = DateSerial(-18, Month(Date), Day(Date))
If MovieRating = "R16" Then
If CustomerDOB > Age16Check Then
MsgBox "This customer is too young to hire this movie"
Else: MsgBox "This customer is old enough to hire this movie"
End If
ElseIf MovieRating = "R18" Then
If CustomerDOB > Age18Check Then
MsgBox "This customer is too young to hire this movie"
Else: MsgBox "This customer is old enough to hire this movie"
End If
Else: MsgBox "This movie does not have a restricted rating, thus this customer may hire this DVD"
End If
End Sub
EDIT: When I run this code, if I have an R16 movie selected, it will say that all the customers are too young to hire it? How can I fix this?
Thanks in advance for your help! :)
Related
I wonder is it still possible to get Facebook user ID if I got 'only' the user's profile (profile username/link)?
For instance:
https://www.facebook.com/zuck
I've tried to do this with SDK and Graph API but it seems that all previous solutions don't work. Could you please give me a hint? I would like to go further but I'm not sure which way is correct.
You can do it with Excel. I put the macros that I use. You have to put the name in the first column and it will generate the id in the second column when you run the GenerateFaceIds macro. (You need to be logged into Facebook in IExplorer)
Sub GenerateFaceIds()
Dim total As Long
total = 1
Do Until IsEmpty(Cells(total, 1)) = True
If (Cells(total, 2) = "") Then
Call faceId(total)
End If
total = total + 1
Loop
MsgBox ("OK")
End Sub
Sub faceId(row As Long)
On Error GoTo ErrHandler
Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")
Dim id As String
id = Cells(row, 1)
With appIE
.Navigate "https://www.facebook.com/" + id
.Visible = False
End With
Do While appIE.Busy
DoEvents
Loop
Text = appIE.Document.Body.innerHTML
posinter = InStr(Text, "profile_owner")
profile_owner = Mid(Text, posinter + 16, 15)
posinter2 = InStr(profile_owner, """")
If posinter2 > 0 Then
profile_owner = Left(profile_owner, posinter2 - 1)
End If
Cells(row, 2) = profile_owner
appIE.Quit
Set appIE = Nothing
ExitSub:
Exit Sub
ErrHandler:
'MsgBox "Something's wrong"
appIE.Quit
Set appIE = Nothing
Resume ExitSub
Resume
End Sub
Result:
zuck 4
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 am trying to write code to have 3 comboboxes change upon selection of each. For Example: In combobox 1 they choose Urban which populates combobox 2 with 2010 and 2011 which then populates combobox 3 with houston, austin and so on. I am trying to use an If then loop but I am getting the error of "Invalid Qualifier" which I am not understanding because it is valid it's been used throughout the whole script. Any help would be great!
Private Sub UserForm_Initialize()
cboStations.Value = "Annual"
cboYear.Value = "2012"
Dim WorkDB As DAO.Database
Dim workRecSetA As DAO.RecordSet
Dim workRecSetB As DAO.RecordSet
Dim x As Integer
Set WorkDB = DBEngine.OpenDatabase("K:\TASS\2 - GEO-DATA PROCESSING SUPPORT\MICHELLE'S WORK_ENTER NOT!!\Work Folder\Map Automation Project\Access Tables\Map_Automation.mdb")
Set workRecSetA = WorkDB.OpenRecordset(Name:="select * from Districts order by District_Name", Type:=dbOpenDynaset)
Do Until workRecSetA.EOF
cboDistrict.AddItem workRecSetA("District_Name")
workRecSetA.MoveNext
Loop
Set workRecSetB = WorkDB.OpenRecordset(Name:="select * from Stations order by Station_Name", Type:=dbOpenDynaset)
Do Until workRecSetB.EOF
cboStations.AddItem workRecSetB("Station_Name")
workRecSetB.MoveNext
Loop
For x = 2010 To 2015
cboYear.AddItem x
Next
End Sub
Private Sub cmdCancel_Click()
frmMapSetUp.Hide
End Sub
Private Sub cboStations_Change()
Dim cboYear As String
If cboStations.Text = "Urban" Then
cboYear.AddItem "2010", "2011", "2012" > Here is where I am receiving the error!!
End If
End Sub
Private Sub cboYear_Change()
Dim cboDistrict As String
If cboYear.Text = "2010" Then
cboDistrict.AddItem "Abilene", "Amarillo", "Austin", "San_Antonio", "Waco", "Wichita_Falls"
Else
cboYear.Text = "2011"
cboDistrict.AddItem "Beaumont", "Houston"
Else
cboYear.Text = "2012" cboDistrict.AddItem "Brownwood", "Bryan", "Childress", "Corpus_Christi", "El_Paso", Lubbock, "Odessa", "Yoakum"
End If
End Sub
Your line
cboYear.AddItem "2010", "2011", "2012"
isn't valid. Have a look at the MSDN docs for manipulating combo boxes.
.AddItem takes one or two arguments - the first is the item, the second is a number that indicates where to insert the item. I would hazard a guess that it's converting '2011' into a number, trying to insert it at position 2011 (which doesn't exist of course, because you don't have 2000+ items in your combo box!) and throwing a wobbly.
Try splitting it up:
cboYear.AddItem "2010"
cboYear.AddItem "2011"
cboYear.AddItem "2012"