I have the below SPSS code in my script;
MsgBox "Progressing"
For iCaseCount = 1 To iNumberOfCases
'my code here
Next
I want to remove the MsgBox and place 'it' inside the loop and replace it's content with; "Progressing record: " & " of " & iNumberOfCases
Is there any way to achieve what I want?
I finally found a way to show the progress via Internet Explorer.
Below is the VB Script Code.
Dim objExplorer
Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.navigate "about:blank" : objExplorer.Width = 350 : objExplorer.Height = 80 : objExplorer.toolbar = False : objExplorer.menubar = False : objExplorer.statusbar = False : objExplorer.Visible = True
For iCaseCount = 1 To iNumberOfCases
DisplayProgress(objExplorer, iCaseCount, iNumberOfCases)
'my code here
Next
objExplorer.Quit
Set objExplorer = Nothing
Method to show progress
Sub DisplayProgress(ByVal x As Object, ByVal stage As Long, ByVal total As Long)
'in code, the colon acts as a line feed
x.Refresh
x.document.write "<font color=black face=Arial>"
x.document.write "Processing record " & stage & " of " & total
x.document.write "</font>"
End Sub
Related
In 2019 comments in Word were redesigned. Therefore there was no autocorrection available in comments anymore.
I used the autocorrection function for substituting my own abbreviations in the comments.
I now wrote a VBA SUB making use of the Comments/Comment object and the AutoCorrect object.
It works fine to substitute my abbreviations in all comments after I wrote them. But to get a more immediate experience, I would like to link the SUB to a "Comment was added"- or "Comment has changed"-Event but I can't find one.
The closest I can get is via a call of my SUB in App_WindowSelectionChange() but the selection of a comment balloon or adding a new comment is not firing that event.
It should work like this:
editing autocorrection fu1 = fuggel1
Select: Word->Developement tools->macros-> Register_Event_Handler()
write comment including "fu1 is the best"
on event changing to "fuggel1 is the best"
Any ideas how to make the call of my SUB related to adding a new comment or changing a comment ?
Rem Class EventACC
Public WithEvents App As Word.Application
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
Rem Debug.Print ("change")
Call Auto_Correct_Comment
End Sub
Rem Module AutoCorrectComment
Dim ACC As New EventACC
Sub Register_Event_Handler()
Set ACC.App = Word.Application
End Sub
Sub Auto_Correct_Comment()
If ActiveDocument.Comments.Count >= 1 Then
For X = 1 To ActiveDocument.Comments.Count
Dim m_s_comment As String
Dim m_s_arr_comment_p() As String
m_s_comment = Trim(ActiveDocument.Comments(X).Range.Text)
m_s_arr_comment_p = Split(m_s_comment, " ")
For C = 0 To UBound(m_s_arr_comment_p)
Rem Debug.Print (m_s_arr_comment_p(C))
On Error Resume Next
Dim m_s_test As String
m_s_test = AutoCorrect.Entries(m_s_arr_comment_p(C)).Value
If Err.Number = 0 Then
Rem Debug.Print (AutoCorrect.Entries(m_s_arr_comment_p(C)).Value)
m_s_comment = Replace(m_s_comment, m_s_arr_comment_p(C), AutoCorrect.Entries(m_s_arr_comment_p(C)).Value)
Rem Debug.Print (m_s_comment)
End If
Next C
ActiveDocument.Comments(X).Range.Text = m_s_comment
Next X
End If
End Sub
I made some progess, now being able to change abbreviations in the selected comment via a key-shortcut (ALT + 0) after writing and confirming it or choosing the comment balloon later on. See code below. Still wanting an event related change.
Usage->Select: Word->Developement tools->macros->AddKeyBinding().
Then use the Key-Shortcut (Alt+0) on comments after writing and confirming them.
Rem Module AutoCorrectComment
Sub Auto_Correct_Comment_2()
If ActiveDocument.ActiveWindow.ActivePane.Selection.Comments.Count >= 1 Then
m_s_comment = Trim(ActiveDocument.ActiveWindow.ActivePane.Selection.Comments.Item(1).Range.Text)
m_s_comment_copy = m_s_comment
Replacement = Array(".", ",", "?", "!", ":") ' add more
For Each A In Replacement
m_s_comment_copy = Replace(m_s_comment_copy, A, " " & A & " ") ' necessary to "free" Autocorrect Element
Next A
m_s_arr_comment_p = Split(m_s_comment_copy, " ")
For C = 0 To UBound(m_s_arr_comment_p)
Rem Debug.Print (m_s_arr_comment_p(C))
On Error Resume Next
Dim m_s_test As String
m_s_test = AutoCorrect.Entries(m_s_arr_comment_p(C)).Value
If Err.Number = 0 Then
Debug.Print (m_s_arr_comment_p(C))
Rem Debug.Print (AutoCorrect.Entries(m_s_arr_comment_p(C)).Value)
m_s_comment = Replace(m_s_comment, m_s_arr_comment_p(C), AutoCorrect.Entries(m_s_arr_comment_p(C)).Value)
Rem Debug.Print (m_s_comment)
End If
Next C
ActiveDocument.ActiveWindow.ActivePane.Selection.Comments.Item(1).Range.Text = m_s_comment
End If
End Sub
Sub AddKeyBinding()
With Application
.CustomizationContext = ActiveDocument.AttachedTemplate
' \\ Add keybinding to Active.Document Shorcut: Alt+0
.KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyAlt, wdKey0), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="Auto_Correct_Comment_2"
End With
End Sub
In Access a header form needs an address associated with it. The header form calls a modal address form. On Save the modal address form will write the address ID to the header form's record source address ID then close. Coming back to the calling header form should then list the related address ID after a requery, that is the FK link. I am not getting the address form's address ID written to the header form's record source address ID field and thus not listing on requery. A fair amount of this code is based on several SO questions.
The header form calls a wrapper function to manage the modal address form:
Private Sub txtJob_AfterUpdate()
gbolDropShipAddressCompleted = False
'Use global variables for use in frmDropShipAddress SQL update statement
gtxtCurrentJobNumber = Me.Job
gtxtCurrentJobRelease = Me.REL
gtxtCurrentJob = Me.txtJob
'Call the wrapper function
gbolDropShipAddressCompleted = fNewDropShipAddressCompletion()
If gbolDropShipAddressCompleted = True Then
'Me.Dirty = False
Me.Requery
With Me.RecordsetClone
.FindFirst "[Job] = '" & gtxtCurrentJobNumber & "' And [REL] = '" & gtxtCurrentJobRelease & "'"
If Not .NoMatch Then
If Me.Dirty Then
Me.Dirty = False
End If
Me.Bookmark = .Bookmark
End If
End With
'Reset all variables
gbolDropShipAddressCompleted = False
gtxtCurrentJobNumber = ""
gtxtCurrentJobRelease = ""
gtxtCurrentJob = ""
End If
End Sub
The wrapper function:
Public Function fNewDropShipAddressCompletion() As Boolean
'Manages call to frmDropShipAddress
DoCmd.OpenForm "frmDropShipAddress", , , , , acDialog, "From frmPackingSlipHeader"
fNewDropShipAddressCompletion = gbolfrmDropShipAddressTofrmPackingSlipHeader
DoCmd.Close acForm, "frmDropShipAddress"
End Function
The modal form's two events:
Private Sub btnSaveAddressInfo_Click()
DoCmd.RefreshRecord
'Update MAIN table with new address id using global variables
CurrentDb.Execute " UPDATE [MAIN] " & _
" SET intADDRESS_ID = " & Me.txtAddress_ID & _
" WHERE JOB = '" & gtxtCurrentJobNumber & "'" & _
" AND REL = '" & gtxtCurrentJobRelease & "'"
gbolfrmDropShipAddressTofrmPackingSlipHeader = True
Me.Visible = False
End Sub
Private Sub Form_Open(Cancel As Integer)
gbolfrmDropShipAddressTofrmPackingSlipHeader = 0
If Me.OpenArgs = "From frmPackingSlipHeader" Then
DoCmd.GoToRecord , , acNewRec
'Coded because TabCtlDatePicker opens all forms and openargs is NULL and causes all forms to be affected
ElseIf IsNull(Me.OpenArgs) Then
Exit Sub
' Else
' Me.PopUp = True
' Me.Modal = True
' Me.BorderStyle = 1
' Me.NavigationButtons = False
' Me.RecordSelectors = False
End If
End Sub
The Access front-end uses several tab controls to select between many different reports/date and or data pickers all sorted into tab control pages by topic. The back-end is MS SQL server via linked tables. The address form may be opened for generic viewing or called (modal). I can't seem to get the correct VBA to get the address form's address ID written to the header's record source and the VBA to get the header to requery and return to the correct record. Any help would be appreciated and TIA.
Tim
I have a VBA form in Corel. Behaving exactly like a similar one in Excel...
Initially, when the form initialize event used to contain only some lines of code, the simple ending line me.txtCsv.Setfocus used to send the focus on it. I mean, it appeared being in edit mode with the cursor blinking inside.
After a period of time, after the application became complex, I am not able to send the focus to the text box in discussion.
I know that Activate event goes last and I also have in it the line me.txtCsv.Setfocus. But without expected result. Inside the Initialization event code I inserted that line Debug.Print Me.ActiveControl.Name & " - 1", changing 1 in 2, 3 up to 6 in many places, including the last line and all the time the name of the text box in discussion (txtCsv) appears in Immediate Window.
So, the control in discussion is the activate one, but the cursor is not inside it when the form is loaded.
TabStop is set to True. I set the TabIndex to 0.
The control is enabled and not blocked. I have created a new simple form with three text boxes and it works well.
I mean the text box which I want to send the focus, has the focus when the form is loaded, keeping a similar code in its Initialize or Activate events.
I compared all properties of the two forms and all text box controls and they are the same...
When I send the focus from another control on the form, the text box in discussion receives it.
It does not receive the focus (anymore) only when the form is shown, the focus being sent by Initialize or Activate evens.
Events code:
Private Sub UserForm_Activate()
Me.txtCsv.SetFocus
End Sub
Private Sub UserForm_Initialize()
Dim P As Printer, i As Long, NrImp As Long, prDefault As String, strJustEngr As String
Dim Printers() As String, n As Long, s As String, boolFound As Boolean
Dim strEng As String, MEngr As Variant, m As Variant, el As Variant, defSize As String
Dim strDropbox As String
boolOpt = True: boolFound = False
Me.cbPrinters.Clear
If Me.chkNewStyle.Value = True Then boolNewStyle = True
prDefault = Application.Printers.Default.Name
strEng = GetSetting(ECA_K, ECA_set, ECA_Engr, "No settings...")
If strEng <> "No settings..." Then
boolSelectedEngravers = True ' only adding engraver is possible...
MEngr = Split(strEng, "|")
'Incarcare in combo:
Me.cbPrinters.Clear
For Each el In MEngr
m = Split(el, ":")
Me.cbPrinters.AddItem m(0)
If m(0) = prDefault Then
boolFound = True
defSize = m(1)
End If
Next
Me.cbPrinters.Value = Me.cbPrinters.List(0)
With Me.btChoosePrinters
.Caption = "Add an Engraver"
.ControlTipText = "Add another Engraver(must be installed)"
End With
Me.btEliminatePrinters.Enabled = True
Me.lblPrinters.Caption = "Engravers: "
Me.cbPrinters.ControlTipText = "Select Engraver to be used!"
Else
Printers = GetPrinterFullNames()
For n = LBound(Printers) To UBound(Printers)
Me.cbPrinters.AddItem Printers(n)
If Printers(n) = prDefault Then boolFound = True
Next n
boolSelectedEngravers = False
End If
Debug.Print Me.ActiveControl.Name & " - 1"
If boolFound Then
Me.cbPrinters.Value = prDefault
Else
Me.lblStatus.Caption = "The default printer (""" & prDefault & """) is not a laser Engraver..."
End If
If GetSetting(ECA_K, ECA_set, "LowRAM", "No settings...") <> "No settings..." Then
boolLowRAM = CBool(GetSetting(ECA_K, ECA_set, "LowRAM", "No settings..."))
End If
If boolLowRAM = True Then
Me.chkLowRAM.Value = True
Else
Me.chkLowRAM.Value = False
End If
Debug.Print Me.ActiveControl.Name & " - 2"
'Direct engrave setting:
Dim strDirectEngrave As String
strDirectEngrave = GetSetting(ECA_K, ECA_set, ECA_Direct_Engrave, "Nothing")
If strDirectEngrave <> "Nothing" Then
Me.chkDirectEngrave.Value = CBool(strDirectEngrave)
If CBool(strDirectEngrave) = True Then
boolDirectEngrave = True
Else
boolDirectEngrave = False
End If
End If
'_______________________________________
strJustEngr = GetSetting(ECA_K, ECA_set, ECA_Just_Engrave, "Nothing")
If strJustEngr <> "Nothing" Then
'Application.EventsEnabled = False
boolChangeEngr = True
Me.chkJustEngrave.Value = CBool(strJustEngr)
boolChangeEngr = False
'Application.EventsEnabled = True
If CBool(strJustEngr) = True Then
Me.chkDirectEngrave.Enabled = True
boolJustEngrave = True
Me.frLocFoldPath.Enabled = True
Else
Me.frLocFoldPath.Enabled = False
Me.chkDirectEngrave.Enabled = False
End If
End If
Debug.Print Me.ActiveControl.Name & " - 3"
If boolSelectedEngravers Then
Application.EventsEnabled = False
Me.btGo.ForeColor = RGB(45, 105, 7)
Me.txtCsv.BackColor = RGB(153, 255, 51)
Me.btGo.Enabled = False
Me.txtCsv.SetFocus
Application.EventsEnabled = True
End If
strDropbox = GetSetting(ECA_K, ECA_set, ECA_Dropbox, "No value")
If strDropbox <> "No value" Then
If CBool(strDropbox) = True Then
Me.chkDropbox.Value = True
End If
End If
AllRefresh
Me.chkCloseDoc.Value = True
Me.txtCsv.SetFocus
Debug.Print Me.ActiveControl.Name & " - 4"
End Sub
Private Sub AllRefresh()
Application.Optimization = False
Application.EventsEnabled = True
If Documents.Count > 0 Then
ActiveWindow.Refresh
ActiveDocument.PreserveSelection = True
End If
Application.Refresh
End Sub
Is there something else, crossing your mind, to be tested?
In the meantime I did some more tests, respectively:
I created a new project (.GMS file) and I imported the form in discussion.I started commenting all the Initialize event code, except the last two code lines.
It didn't set the focus! Commenting everything, letting only the Activate event code, it worked.
I started to un-comment lines in Initialize event code and I found a line not allowing the focus to be sent to that text box.
Setting the value of the combo: Me.cbPrinters.Value = Me.cbPrinters.List(0), moving it in the Activate event code, before the part pointing to txtCSV, worked well.
Now, I tried to do the same in the original form and it does not work...
The above question has been solved by Disabling followed by Enabling of the text box in discussion, but only doing that in Form Activate event. It did not work in Initialize event...
Private Sub UserForm_Activate()
Me.txtCsv.Disable: Me.txtCsv.Enable
Me.txtCsv.SetFocus
End Sub
I have the below VBA code in access to enable/disable a text box.
When the code is executed the tonnes textbox remains disabled.
Am I missing an additional property?
Private Sub EnableTonnes()
Dim sCode As String
sCode ="xx"
' set default values for tonnes enabled and locked properties
Tonnes.enabled = False
Tonnes.Locked = True
If sCode = "xx" Then
' enable tonnes field
Tonnes.enabled = True
Tonnes.Locked = False
End If
End Sub
Your code looks ok. TextBox properties are set in form design mode and can only be permanently changed in form design mode. You do some sophisticated coding to open the form in design mode, change the properties and then save the form... or do it manually. You will always be able to use your code to control those properties at runtime.
Option Compare Database
Option Explicit
Private Sub cmdGo_Click()
Dim sCode As String
sCode = "xx"
' set default values for tonnes enabled and locked properties
txtTonnes.Enabled = False
txtTonnes.Locked = True
If sCode = "xx" Then
' enable tonnes field
txtTonnes.Enabled = True
txtTonnes.Locked = False
End If
MsgBox txtTonnes.Name & " Enabled status is " & txtTonnes.Enabled
MsgBox txtTonnes.Name & " Locked status is " & txtTonnes.Locked
End Sub
Private Sub Form_Load()
MsgBox txtTonnes.Name & " Enabled status is " & txtTonnes.Enabled
MsgBox txtTonnes.Name & " Locked status is " & txtTonnes.Locked
End Sub
I am using VBA and SQL to re-query my main form based on criteria entered in several controls on a pop up form. As far as I can tell the code is running correctly, the database is re-queried based on the criteria I enter, but 2 of my controls on my main form show as #Name? or blank after re-querying based on the criteria. Anyone know how I can fix this???
The code that runs the re-query is:
Public Sub SuperFilter()
On Error GoTo Err_AdvancedFilter_Click
Dim strSQL As String
Dim strCallNumber As String
Dim strAsgnTech As String
Dim strClientID As String
Dim strCallGroup As String
Dim strPriority As String
Dim strOpenStatus As String
If IsNull(Forms![frmTips&Tricks].txtCallNumber) = False Then
strCallNumber = " (((CallInfo.CallNumber) = forms![frmTips&Tricks].[txtCallNumber])) and "
Else
strCallNumber = ""
End If
If IsNull(Forms![frmTips&Tricks].cboAsgnTech) = False Then
strAsgnTech = " (((CallInfo.AsgnTech) = forms![frmTips&Tricks].[cboasgntech])) and "
Else
strAsgnTech = ""
End If
If IsNull(Forms![frmTips&Tricks].cboClientID) = False Then
strClientID = " (((CallInfo.ClientID) = forms![frmTips&Tricks].[cboClientID])) and "
Else
strClientID = ""
End If
If IsNull(Forms![frmTips&Tricks].cboCallGroup) = False Then
strCallGroup = " (((CallInfo.AsgnGroup) = forms![frmTips&Tricks].[cboCallGroup])) and "
Else
strCallGroup = ""
End If
If IsNull(Forms![frmTips&Tricks].cboPriority) = False Then
strPriority = " (((CallInfo.Severity) = forms![frmTips&Tricks].[cboPriority])) and "
Else
strPriority = ""
End If
If Forms![frmTips&Tricks].optOpenStatus.Value = 1 Then
strOpenStatus = " (((CallInfo.OpenStatus) = True))"
Else
strOpenStatus = " (((CallInfo.OpenStatus) is not null ))"
End If
strSQL = "SELECT CallInfo.CallNumber, CallInfo.ClientID,* " & _
"FROM dbo_HDTechs INNER JOIN ([User] INNER JOIN CallInfo ON User.ClientID = CallInfo.ClientID) ON dbo_HDTechs.TechName = CallInfo.AsgnTech " & _
"WHERE " & strCallNumber & strAsgnTech & strClientID & strCallGroup & strPriority & strOpenStatus & _
"ORDER BY CallInfo.RcvdDate;"
Form.RecordSource = strSQL
Me.cboCallNumber.RowSource = strSQL
Form.Requery
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "No Records Found: Try Diferent Criteria."
Form.RecordSource = "qryservicerequestentry"
Me.cboCallNumber.RowSource = "qryservicerequestentry"
Exit Sub
End If
Me.cmdSuperFilterOff.Visible = True
Exit Sub
Exit_cmdAdvancedFilter_Click:
Exit Sub
Err_AdvancedFilter_Click:
MsgBox Err.Description
Resume Exit_cmdAdvancedFilter_Click
End Sub
The first control in question is a combo box that displays the Client Name from the CallInfo form (Main Form).
Control Source: ClientID
And when expanded lists all available clients to select from the Users form (User ID is linked between the User form and CallInfo form).
Row Source: SELECT User.ClientID FROM [User];
After the re-query, this combobox will be blank, sometimes showing #Name? if you click on it.
The second control in question is a text box that shows the Client's phone number.
Control Source: PhoneNo
After the Re-query, this text box always displays #Name?
The third control in question is a text box that displays the clients office location.
Control Source: Location
What really baffles me is that THIS text box displays correctly after the re-query. I don't know why it would display the correct data when the Phone Number text box does not, seeing as they are so similar and work with similar data....
To Compare, the The form record source is normally based on:
SELECT CallInfo.CallNumber, CallInfo.ClientID, CallInfo.RcvdTech, CallInfo.RcvdDate, CallInfo.CloseDate, CallInfo.Classroom, CallInfo.Problem, CallInfo.CurrentStatus, CallInfo.Resolution, CallInfo.Severity, CallInfo.OpenStatus, CallInfo.AsgnTech, dbo_HDTechs.Email, CallInfo.FullName, CallInfo.AsgnGroup, User.Location, User.PhoneNo, CallInfo.OpenStatus
FROM dbo_HDTechs INNER JOIN ([User] INNER JOIN CallInfo ON User.ClientID = CallInfo.ClientID) ON dbo_HDTechs.TechName = CallInfo.AsgnTech
WHERE (((CallInfo.OpenStatus)=True))
ORDER BY CallInfo.RcvdDate;
Just going on what you wrote, I may take a slightly different approach (just personal preference).
I would change all of your 'IsNull' tests to also check for 'Empty'. i.e.
If IsNull(Forms![frmTips&Tricks].cboClientID) = False AND ...cliientID <> ""
Just today I had an issue relating to form references in a query WHERE clause, so I changed to:
strClientID = " (((CallInfo.ClientID) = '" & forms![frmTips&Tricks].[cboClientID] & "')) and"
Add a Debug.Print of your generated SQL, then look at it and try to run that SQL manually
Good Luck,
Wayne
Solved by designating the form in the control source like: CallInfo.ClientID
I still don't know why the Client Office displayed Correctly... Anybody have a hint? :)
TE