Here as you can see I'm not using combox_click because it is declared above and the current one is another function to be called without clicking, here my question is how do I get the pre-selected value from the combo box without clicking on the box?
Public Sub ComDep_Change()
Dim sQuery As String
Dim oRS As New ADODB.Recordset
Dim rsPR As New ADODB.Recordset
Dim dateFormat As String
Dim sPONO As String
Dim sPOAmt As String
'oRS.Open "po_receiveable", PRCnn, adOpenDynamic, adLockOptimistic
combVal = ComDep.List(ComDep.ListIndex)
If Not combVal = "ALL_DEPT" And frmMain.OptLatestCN.Value = True Then
'MsgBox ("Works")
dateFormat = "#" + CStr(Day(Now)) + "/" + CStr(Month(Now)) + "/" + CStr(Year(Now) - 3) + "#"
sQuery = "select * from CN_Request_Header where dept = '" & combVal & "' and requestdate >= " & dateFormat & ""
' sQuery = "Select PO_No, PO_Requestor, PO_Req_Dept, PO_Status, PO_Approval_M, PO_Approval_GM, PO_Approval_D, PO_HRApproval, VC_No, TH_Sup_Inv, PO_HR_Rmk, PO_Req_Date, PO_SupplierName, PO_OverallAmt from PR_INFO where PO_Req_Dept = '" & combVal & "'"
' MsgBox ("Result" & sQuery)
rsPR.Open sQuery, PRCnn, adOpenDynamic, adLockOptimistic
lvwCreditNote.ListItems.Clear
Do While Not rsPR.EOF
Set listitem = frmMain.lvwCreditNote.ListItems.Add
With listitem
.Text = CStr(Trim(rsPR!requestID))
.SubItems(1) = Trim(rsPR!requestID)
.SubItems(2) = Format(CStr(rsPR!requestdate), "dd-mmm-yy")
.SubItems(3) = Trim(rsPR!createby)
.SubItems(4) = Trim(rsPR!dept)
.SubItems(5) = Trim(rsPR!reqstatus)
If IsNull(rsPR!custName) Then
.SubItems(6) = ""
Else
.SubItems(6) = Trim(rsPR!custName)
End If
If IsNull(rsPR!cnamt) Then
.SubItems(7) = "0.00"
Else
.SubItems(7) = Format(rsPR!cnamt, "#,###,##0.00")
End If
You would get the currently SELECTED element in a combobox
by using the SELECTEDINDEX Property
If nothing is selected then you get the value -1 returned to you.
If something is selected it will be in the range 0 to Combox.Count - 1
To get the text for the selected item
You could use something like...
Dim SelIndex as Integer
Dim SelText As String
'
SelIndex = MyCombobox.SelectedIndex
If (SelIndex >= 0) AND (SelIndex <= MyCombobox.Count - 1) Then
SelText = MyCombobox.List(Index)
Else
'Nothing was selected in the combobox
End If
Related
I am trying to remove or hide the 4 commandbuttons when exporting to PDF. The way I do it works for the first time exporting but if I export the same file again, I'll get an error referring to this line: Me.CommandButton3.Select even though all buttons are back. Is there a better way of hiding without having to delete them? I dont have printobject under properties as suggested on the internet. I should add, I still have other macros like a publish_date I do not wanna remove.
Also, I realized those commandbuttons arent saved as shapes, so trying to hide shapes didnt work either. But what about linking them to shapes and making the other shapes go into the fore and background when saving to PDF? would that work?!
Another idea was perhaps something like this:
Dim s As Shape
For Each s In ActiveDocument.Shapes
If s.Type = msoFormControl Then
If s.Type = wdButtonControl Then
s.Delete
End If
End If
Next s
It isnt working and I need the buttons back after exporting. Below my code with deleting the buttons, getting them back, but also getting an error with commandbutton 3 not working anymore, which is saving the file as .docm:
Private Sub CommandButton1_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Finale Versionen\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim Title As String: Title = "Besprechungsnotizen"
Dim newTitle As String
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim User As String
Dim Version As String
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
Title = nameElements(UBound(nameElements) - 3)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
End If
Version = "0"
Else
newVersion = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Neue Version")
If newVersion = vbYes Then
Dim currentUser As String
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & currentUser
End If
Version = Format$(Version + 1)
Else
Version = Format$(Version)
End If
End If
Me.CommandButton1.Select
Selection.Delete
Me.CommandButton2.Select
Selection.Delete
Me.CommandButton3.Select
Selection.Delete
Me.Refresh.Select
Selection.Delete
ActiveDocument.ExportAsFixedFormat OutputFileName:=FilePath & _
MyDate & "_" & Title & "_i_0" & Version & "_" & User & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
IncludeDocProps:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, _
BitmapMissingFonts:=True
ActiveDocument.Undo
ActiveDocument.Undo
ActiveDocument.Undo
ActiveDocument.Undo
ActiveDocument.Undo
End Sub
Ok I found a solution that works with a few tricks. So I added 4 rectangle shapes and I only wanna make 3 disappear while saving as PDF. It works when I wrap 3 of those shapes behind the text (or buttons) and add
With ActiveDocument
.Shapes(1).WrapFormat.Type = wdWrapFront
ActiveDocument.ExportAsFixedFormat OutputFileName:=FilePath & ...
...
.Shapes(1).WrapFormat.Type = wdWrapBehind
End With
Somehow it does put those 3 in front of the text and only puts those three behind the text again and leaving the 4th rectangle permanent in front of another text. Just as I want it. Below my entire code:
Private Sub CommandButton1_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Finale
Versionen\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim Title As String: Title = "Besprechungsnotizen"
Dim newTitle As String
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim User As String
Dim Version As String
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
Title = nameElements(UBound(nameElements) - 3)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
End If
Version = "0"
Else
newVersion = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Neue Version")
If newVersion = vbYes Then
Dim currentUser As String
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & currentUser
End If
Version = Format$(Version + 1)
Else
Version = Format$(Version)
End If
End If
With ActiveDocument
.Shapes(1).WrapFormat.Type = wdWrapFront
ActiveDocument.ExportAsFixedFormat OutputFileName:=FilePath & _
MyDate & "_" & Title & "_i_0" & Version & "_" & User & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
IncludeDocProps:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, _
BitmapMissingFonts:=True
.Shapes(1).WrapFormat.Type = wdWrapBehind
End With
End Sub
I have an unsecured query which allows for an injection, and I'm not sure how to go about parameterizing it to prevent said injection
Dim sInsertSQL As String
sInsertSQL = "Insert into tbl_userprop (Prop_Def) values "
Dim tempString As String() = PropertyDefinitions.Split("|")
For i As Integer = 1 To tempString.Length
If tempString(i - 1).Length > 0 Then
sInsertSQL = sInsertSQL + " ('" + tempString(i - 1) + "'),"
bInsert = True
End If
Next
There are up to 10 values stored in tempString and they are concatenated onto sInsertSQL as such: ('val1'), ('val2'), etc
Figured it out, update for the curious:
Dim lstParams As New Collections.Generic.List(Of SqlParameter)
Dim tempString As String() = PropertyDefinitions.Split("|")
For i As Integer = 1 To tempString.Length
If tempString(i - 1).Length > 0 Then
Dim sParamName As String = String.Format("#param{0}", i)
Dim sparam As New SqlParameter(sParamName, tempString(i - 1))
lstParams.Add(sparam)
sInsertSQL = sInsertSQL + " (" + sParamName + "),"
bInsert = True
End If
Next
Once you have split the string you know how many parameters there will be, so you can create the # items for the SQL. After that, you can add the parameters by going through the lists of parameter names and values:
Dim PropertyDefinitions = "abc|def|ghi|jkl|mno"
Dim values = PropertyDefinitions.Split({"|"c})
Dim paramNames = Enumerable.Range(0, values.Count()).Select(Function(n) $"#p{n}")
Dim paramList = String.Join(", ", paramNames.Select(Function(s) $"({s})"))
Dim sql = "INSERT INTO [tbl_userprop] (Prop_Def) VALUES " & paramList
' The following line with the sample data would output '
' INSERT INTO [tbl_userprop] (Prop_Def) VALUES (#p0), (#p1), (#p2), (#p3), (#p4)
'Console.WriteLine(sql)
Dim connStr = "YourConnectionStringHere"
Using conn As New SqlConnection(connStr)
Using cmd As New SqlCommand(sql, conn)
For i = 0 To values.Count() - 1
'TODO: Set the .SqlDbType and .Size to conform to the database definition of [tbl_userprop]. '
cmd.Parameters.Add(New SqlParameter With {.ParameterName = paramNames(i),
.Value = values(i),
.SqlDbType = SqlDbType.NVarChar,
.Size = 99})
Next
'conn.Open()
'cmd.ExecuteNonQuery()
End Using
End Using
I have a ComboBox that is created when the page is initialised
Dim CategoryCombo As New CustomControl.ComboCBx
With CategoryCombo
.Name = "MaintTypes_CatCombo"
End With
RegisterControl(MaintenanceTypes_Grid, CategoryCombo)
vToolBar.Items.Add(CategoryCombo)
vToolBar.Items.Add(TS_Separator)
and added to the toolbar
It is populated in the load event
Dim CatCombo As CustomControl.ComboCBx = MaintenanceTypes_Grid.FindName("MaintTypes_CatCombo")
With CatCombo
.IsNewRecord = False
.Width = 200
.ItemsSource = ReturnCategories.DefaultView
.SelectedValuePath = "ID"
.DisplayMemberPath = "Name"
.SelectedIndex = 0
End With
If the user navigates to another page and returns the selected value is returned to the selected index of 0. I can grab the last selected value before leaving the page but cannot find a way to set .SelectedValue when the page reloads
Data comes from
Private Function ReturnCategories() As DataTable
Try
CatDT = New DataTable
With CatDT.Columns
.Add("ID", GetType(Integer))
.Add("Name", GetType(String))
End With
With CatDT.Rows
.Add(0, "Select Category")
End With
Using vService As New Service1Client
strSQL = "SELECT Category_ID as 'ID', Category_Name as 'Name' FROM Maintenance_Categories "
strSQL += "WHERE Management_ID = " & Management_ID
strSQL += " ORDER BY Category_Name"
Dim DS As DataSet = vService.ReturnDataSetHAS(strSQL)
For Each Row As DataRow In DS.Tables(0).Rows
With CatDT.Rows
.Add(Row("ID"), ReturnText(Row("Name")))
End With
Next
End Using
Return CatDT
Catch ex As Exception
EmailError(ex)
Return Nothing
End Try
End Function
Any ideas?
Thanks
Found a workaround - return the index from the DataTable and set the .SelectedIndex of the ComboBox with that
In case someone has deleted the selected item prior to returning to the page check the row exists first
Dim vIndex As Integer = 0
If Not CurrentCategory = 0 Then
Dim vRow As DataRow = CatDT.Select("ID = '" & CurrentCategory & "'").FirstOrDefault()
If Not vRow Is Nothing Then
vIndex = CatDT.Rows.IndexOf(vRow)
End If
End If
With CatCombo
.IsNewRecord = False
.Width = 200
.ItemsSource = ReturnCategories.DefaultView
.SelectedValuePath = "ID"
.DisplayMemberPath = "Name"
.SelectedIndex = vIndex
End With
If there is a change of data in one tab on a page we need to see the update if the user changes something and moves to another tab...
This works perfectly with a Grid
Private Async Sub Telephone_ReturnData()
Try
Dim DGV As CustomControl.DGVx = Prospect_Grid.FindName("Telephone_DGV")
strSQL = "SELECT Prospect_TelephoneCalls.Transaction_ID as 'ID', "
strSQL += "Prospect_Contacts.Contact_FirstName + ' ' + Prospect_Contacts.Contact_Surname as 'Contact', "
strSQL += "Prospect_TelephoneCalls.Call_Date as 'Date' "
strSQL += "FROM Prospect_TelephoneCalls "
strSQL += "JOIN Prospect_Contacts ON Prospect_TelephoneCalls.Contact_ID = Prospect_Contacts.Contact_ID "
strSQL += "WHERE Prospect_TelephoneCalls.Prospect_ID = " & Prospect_ID
strSQL += " ORDER BY Prospect_TelephoneCalls.Call_Date DESC"
Await Task.Run(Sub()
Using vService As New Service1Client
Using DS As DataSet = vService.ReturnDataSetHAS(strSQL)
TelephoneDT = DS.Tables(0).Copy
End Using
End Using
End Sub)
DGV_ColumnDefinitions(DGV, TelephoneDT)
DGV.ItemsSource = TelephoneDT.DefaultView
Dim vRecords As Integer = TelephoneDT.Rows.Count
Dim vOutput As String = "One record returned..."
If Not vRecords = 1 Then
vOutput = vRecords & " records returned..."
End If
PageStatusBarLoaded(Prospect_Grid, vOutput)
Catch ex As Exception
EmailError(ex)
End Try
End Sub
End Region
But do the same thing with a ComboBox is goes into and endless loop and the app freezes.
Private Async Sub ReloadTelephoneContacts()
Try
'If TelephoneContactsDT Is Nothing Then
' TelephoneContactsDT = New DataTable
'Else
' TelephoneContactsDT.Dispose()
' TelephoneContactsDT = New DataTable
'End If
'' Dim DT As New DataTable
'With TelephoneContactsDT.Columns
' .Add("ID", GetType(Integer))
' .Add("Name", GetType(String))
'End With
'With TelephoneContactsDT.Rows
' .Add(0, "Select Contact")
'End With
Await Task.Run(Sub()
strSQL = "Select Contact_ID as 'ID', Contact_FirstName + ' ' + Contact_Surname as 'Name' FROM Prospect_Contacts WHERE Prospect_ID = " & Prospect_ID
Using vService As New Service1Client
Using DS As DataSet = vService.ReturnDataSetHAS(strSQL)
TelephoneContactsDT = DS.Tables(0).Copy
'For Each Row As DataRow In DS.Tables(0).Rows
' With TelephoneContactsDT.Rows
' .Add(Row("ID"), ReturnText(Row("Name")))
' End With
'Next
End Using
End Using
End Sub)
Dim SpokeToCB As CustomControl.ComboCBx = Prospect_Grid.FindName("Telephone_SpokeToCB")
'SpokeToCB.ItemsSource = Nothing
With SpokeToCB
.ItemsSource = TelephoneContactsDT.DefaultView
.DisplayMemberPath = "Name"
.SelectedValuePath = "ID"
.SelectedIndex = 0
End With
PageStatusBarRightChangeText(Prospect_Grid, "Telephone text")
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Any idea how I can overcome this?
It works perfectly if run during initialised but needs to be updated
Thanks
Moving the reload sub to the end of the adding the new contact sub did the trick. Apart from anything else selecting a new value from any ComboBox causes the TabController.SelectionChanged event to fire each time
Where a DataTable has the following Columns
Account Number (Integer) (Unique)
Debit (Decimal)
Credit (Decimal)
Selected (Boolean)
There may be several rows with the same account number and either a Debit Entry or a Credit Entry. What I am attempting to do is match up the debits and credits where they add up to the same value and mark them as selected by iterating through all the rows. Any idea on the best method to achieve this?
Thanks
e.g.
SQL
strSQL = "SELECT A_Sales_Ledger.Transaction_ID as 'Transaction', "
strSQL += "Customers.Cust_No as 'Acct', "
strSQL += "Customers.Cust_Name as 'Name', "
strSQL += "Customers.Add1 as 'Unit', "
strSQL += "A_Sales_Ledger.Debit as 'Debit', "
strSQL += "A_Sales_Ledger.Credit as 'Credit', "
strSQL += "A_Sales_Ledger.Document_Date as 'Date', "
strSQL += "A_Sales_Ledger.S_Description as 'Description' "
strSQL += "FROM A_Sales_Ledger "
strSQL += "JOIN Customers ON Customers.Customer_ID = A_Sales_Ledger.Customer_ID "
strSQL += "WHERE A_Sales_Ledger.Paid = 'N' "
strSQL += "ORDER BY Customers.Cust_No"
This may not be the best solution but it does seem to work...
I'm making three passes though the DataTable
Pass one - if the total of the debits equals the total of the credits for each customer mark them as selected
Pass two - Add the total of the credits for the customer and iterate though the debits until the same value is achieved and mark them as selected
Pass three - mop up any remaining credit entries that match a debit entry for the same customer...
For Each Row As DataRow In BalanceDT.Rows
Dim vAcct As String = Row("Acct")
Dim vDebits As Decimal = BalanceDT.Compute("SUM(Debit)", "Acct = '" & vAcct & "'")
Dim vCredits As Decimal = BalanceDT.Compute("SUM(Credit)", "Acct = '" & vAcct & "'")
If vDebits = vCredits Then
Row("Selected") = True
End If
Next
Dim CurrentCust As String = ""
Dim TransactionDT As New DataTable
Dim ExitFor As Boolean = False
With TransactionDT.Columns
.Add("ID", GetType(Integer))
End With
For Each Row As DataRow In BalanceDT.Rows
Dim vAcct As String = Row("Acct")
ExitFor = False
TransactionDT.Rows.Clear()
If Not CurrentCust = vAcct Then
Dim vCredits As Decimal = BalanceDT.Compute("SUM(Credit)", "Acct = '" & vAcct & "'")
Dim vSelected() As DataRow = BalanceDT.Select("Acct = '" & vAcct & "'", Nothing)
For Each SubRow As DataRow In vSelected
If SubRow("Selected") = False Then
vCredits -= SubRow("Debit")
With TransactionDT.Rows
.Add(SubRow("Transaction"))
End With
If vCredits = 0 Then
ExitFor = True
Exit For
End If
End If
Next
If ExitFor = True Then
For Each SubRow As DataRow In vSelected
If SubRow("Credit") > 0 Then
SubRow("Selected") = True
End If
If SubRow("Debit") > 0 Then
For Each CustomerRow As DataRow In TransactionDT.Rows
If CustomerRow("ID") = SubRow("Transaction") Then
SubRow("Selected") = True
End If
Next
End If
Next
End If
End If
CurrentCust = vAcct
Next
For Each Row As DataRow In BalanceDT.Rows
Dim vAcct As String = Row("Acct")
If Not CurrentCust = vAcct Then
Dim vSelected() As DataRow = BalanceDT.Select("Acct = '" & vAcct & "' AND Selected = 'False'", "Credit")
For Each SubRow As DataRow In vSelected
If SubRow("Selected") = False Then
Dim vCredit As Decimal = SubRow("Credit")
For Each CustomerRow In vSelected
If CustomerRow("Selected") = False Then
Dim vDebit As Decimal = CustomerRow("Debit")
If Not vDebit = 0 And Not vCredit = 0 Then
If vDebit = vCredit Then
With TransactionDT.Rows
CustomerRow("Selected") = True
SubRow("Selected") = True
End With
Exit For
End If
End If
End If
Next
End If
Next
End If
CurrentCust = vAcct
Next