VB6 - How could I get the ListBox selected id - listbox

AS I using the VB6.0 for create a Dialog Box with the ListBox, but only I can get the String text with Trim(DlgText$("xxxxx")), for the other side still I could not found how to get it.
Most of the answer from network said that could be using [LisBox_ID].Selected to get the item that what they want, but I can not get the same result.
For my Code:
[Dialog]
Function aOpenDialog As Boolean
aOpenDialog = False
iArrayLoop = 0
Begin Dialog UserDialog ,,250,120,ScriptTitle,.ActivateDlgControls
Text 5,5,130,10,"Sub Booking End Date", .tf_InsertionSetEndDate
ListBox 5,15,100,100,aArrayList, .aArrayList
Text 110,5,130,10,"After Date [DD-MMM-YYYY]", .tf_AfterDate
TextBox 110,15,55,10, .txt_AfterDate
Text 110,25,55,10,"Change Reason", .tf_ChangeReason
TextBox 110,35,130,10, .txt_ChangeReason
OKButton 110,45,70,10, .btn_Save
CancelButton 110,55,70,10, .btn_Cancel
End Dialog
Dim dlg As UserDialog
aArrayList(1) = "Day1"
aArrayList(2) = "Day2"
Dialog dlg
End Function
[ActiveDlgControls]
Function ActivateDlgControls(ControlName$, Action%, SuppValue%)
If (Action% = 2 And ControlName$ = "btn_Save") Then
sMissingMessage = ""
If (Not IsDate(CStr(Trim(DlgText$("txt_AfterDate"))))) Then
sMissingMessage = sMissingMessage & "- Please input the correct day format"
Else
MsgBox Format(Trim(DlgText$("txt_AfterDate")), "dd mmm yyyy")
' This Area will be using for get the selected array item id
' I can found the selected items with String
MsgBox Trim(DlgText$("aArrayList"))
' Unknow way to found the selected items id
' MsgBox dlg.aArrayList.SelectedItem(x)
End If
If (sMissingMessage <> "") Then
ActivateDlgControls = 1
iCheckResult = 1
sMissingMessage = "Information Missing:" & sMissingMessage
MsgBox sMissingMessage
End If
ElseIf (Action% = 2 And ControlName$ = "btn_Cancel") Then
iCheckResult = 2
End If
End Function
Any idea how should I get the selected ListBox item?
I want to get the array number that I selected inside the LisBox.
Although I got an other stupid idea for get the index like as below code:
For iArrayLoopCheck = 0 To UBound(aArrayList)
If (aArrayList(iArrayLoopCheck) = Trim(DlgText$("aArrayList")))Then
MsgBox "You Select item: " & iArrayLoopCheck
Exit For
End If
Next
Still I was looking for any smart code/ items/ easy way to get the result quickly just like get the String value in array like: Trim(DlgText$("xxxxx"))
Best Regards,
KT

To get the selected index of the list box:
list.ListIndex
returns 0 if the first item is selected, 1 if the second item is selected, etc., and -1 if no item is selected.

Related

Google Sheet If dropdown

I have drop down for column A where I want to select value from drop down only for certain times (ie. 3 times), after I select value from dropdown 3 times, if I try to select it 4th time, value should be removed from dropdown or not able to select. Is this possible using excel or google sheet?
https://docs.google.com/spreadsheets/d/1nbXAkK565V24KDTAzE68q8rQgQWzn-jDJz_6piNYyEw/edit?usp=sharing
In above google sheet, I had selected Red 3 times, now if I want to select Red 4th time, I should not be able to select or Red should be removed from list.
I know using excel VBA, I can do same using below code, but can we add same to google sheets?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lVal As Long
Dim check2 As Long
If Target.Count > 2 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
lVal = Application.WorksheetFunction _
.CountIf(Columns(Target.Column), _
"*" & newVal & "*")
If lVal > 3 Then
If newVal = "" Then
'do nothing
Else
MsgBox "Not available"
Target.Value = oldVal
End If
Else
If Target.Column >= 47 And Target.Column <= 56 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
So after doing some research I found the way of achieving what you were aiming for here.
Solution
In the class data validation it mentions a method to set the validation to null within the range class. You can check more details about this method here. In that method it mentions that if the parameter is set to null, it will disable the data validation (dropdowns) therefore not allowing to select other values.
Here is a piece of sample code self explained with comments to achieve what you want in your specific case:
function onEdit(){
// get the sheet and values to check if in that range there are more than 3 elements selected
var ss = SpreadsheetApp.getActiveSheet();
var values = ss.getRange('A1:A18').getValues();
// this variable is for counting the amount of elements selected
var count = 0;
for(i=0;i<values.flat().length;i++){
// if an element in that range is not empty
if(values.flat()[i]!=''){
count++;
}
}
// if the count is over 3 then disable the dropdowns
if(count>3){
ss.getRange('A1:A18').setDataValidation(null);
}
}
I hope this has helped you. Let me know if you need anything else or if you did not understood something. :)

HPQC - RecordSet Not Displaying All Data

I am using HP (Microfocus) Quality Center 12.5 and designed a button using the toolbar in Workflow.
The following code pulls the first value from the RecordSet but not all values. How do I pull all values from the RecordSet and display it?
Sub searchDefects()
On Error Resume Next
Dim a
a = InputBox("Enter search query")
set TD1 = TDConnection
set com1 = TD1.command
com1.CommandText = "Select BG_BUG_ID FROM BUG WHERE BG_DESCRIPTION LIKE '%"
&a &"%'"
set rec1 = com1.Execute
Dim i
DIM msg
msg = ""
rec1.First
For i = 0 to rec1.RecordCount
msg = msg & "," & rec1.FieldValue(i) & ","
rec1.Next()
Next
MsgBox msg
On Error GoTo 0
End Sub
I found a solution after trial and error but still don't know the reason behind the root cause and how it is solving it. Any feedback is appreciated.
Sub SearchDefectsDescription()
On Error Resume Next
Dim a
a = InputBox("Enter search query for Description field")
set TD1 = TDConnection
set com1 = TD1.command
com1.CommandText = "Select BG_BUG_ID FROM BUG WHERE BG_DESCRIPTION LIKE '%" &a &"%'"
set rec1 = com1.Execute
Dim i
DIM msg
msg = "Bug ID" & vbnewline
rec1.First
If a = vbCancel Then
MsgBox "Search is cancelled"
Exit Sub
ElseIf Len(a) = 0 Then
MsgBox "Search input is empty, plesea try again."
Exit Sub
Else
For i = 0 to rec1.RecordCount
msg = msg & rec1.FieldValue(0) & rec1.FieldValue(1) & " "
rec1.Next()
Next
End If
MsgBox msg
On Error GoTo 0
End Sub

Concatenate dynamic text values based on criteria in excel

I have a worksheet were I am trying to concatenate dynamic text values based on =TODAY()
So I have B3:B1000 being the fields where users will enter in text. D3:D1000 is where the user enters the date they filled it in. I3 is =TODAY()
How do I concatenate text values in B3:B1000 based on if the dates in the D3:D1000 = I3? and have that concatenation always update based on I3?
I would also need a delimiter of ", "
Got it working after some trail and error and some deeper searching :)
Function ConcatenateIf(CriteriaRange As Range, Condition As Variant, _
ConcatenateRange As Range, Optional Separator As String = ",") As Variant
Dim i As Long
Dim strResult As String
On Error GoTo ErrHandler
If CriteriaRange.Count <> ConcatenateRange.Count Then
ConcatenateIf = CVErr(xlErrRef)
Exit Function
End If
For i = 1 To CriteriaRange.Count
If CriteriaRange.Cells(i).Value = Condition Then
strResult = strResult & Separator & ConcatenateRange.Cells(i).Value
End If
Next i
If strResult <> "" Then
strResult = Mid(strResult, Len(Separator) + 1)
End If
ConcatenateIf = strResult
Exit Function
ErrHandler:
ConcatenateIf = CVErr(xlErrValue)
End Function
and then used this concatenate function =ConcatenateIf(D3:D1000,I3,B3:B1000,", ")

Macro to find paragraphs in text selection in Open/Libre/Neo Office

I am trying to enumerate the paragraphs selected by the user in (Neo|Libre|Open)Office.
When I use the code below, modified version from here,
Sub CheckForSelection
Dim oDoc as Object
Dim oText
oDoc = ThisComponent
oText = oDoc.Text
if not IsAnythingSelected(oDoc) then
msgbox("No text selected!")
Exit Sub
end if
oSelections = oDoc.getCurrentSelection()
oSel = oSelections.getByIndex(0)
' Info box
'MsgBox oSel.getString(), 64, "Your Selection"
oPE = oSel.Text.createEnumeration()
nPars = 0
Do While oPE.hasMoreElements()
oPar = oPE.nextElement()
REM The returned paragraph will be a paragraph or a text table
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
ElseIf oPar.supportsService("com.sun.star.text.TextTable") Then
nTables = nTables + 1
end if
Loop
' Info box
MsgBox "You selection has " & nPars & " paragraphs.", 64
end Sub
it finds ALL the paragraphs in the document, not just in the selection. Google has failed me. Any thoughts on how to find individual paragraphs in the selection?
The oSel.Text is a shortcut for oSel.getText() which "Returns the text interface in which the text position is contained." https://www.openoffice.org/api/docs/common/ref/com/sun/star/text/XTextRange.html#getText
So to get a ParagraphEnumeration only from the Selection, you should use oPE = oSel.createEnumeration() instead of oPE = oSel.Text.createEnumeration().

MS Outlook - Change The Hyperlink Tooltip

Does anyone have an idea how I could change the displayed tooltip when a mouse hovers over a hyperlink in an email?
The screentip can be set with Word's Hyperlinks.Add method.
http://msdn.microsoft.com/en-us/library/office/ff837214%28v=office.15%29.aspx
expression .Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay, Target)
This describes how you use Hyperlinks.Add in Outlook.
http://msdn.microsoft.com/en-us/library/dd492012%28v=office.12%29.aspx
strLink = "http://www.outlookcode.com"
strLinkText = "Get Outlook code samples here"
Set objInsp = objMsg.GetInspector
If objInsp.EditorType = olEditorWord Then ' <===
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Windows(1).Selection
If objMsg.BodyFormat <> olFormatPlain Then
objDoc.Hyperlinks.Add objSel.Range, strLink, _
"", "", strLinkText, ""
Else
objSel.InsertAfter strLink
End If
End If

Resources