I'd like to create a Commandbutton with functionality to paste a date in to the cell to its left - I need to copy this button below in future.
I am trying:
Private Sub CommandButton2_Click()
Dim Str As String
Str = Date
Range(TopLeftCell).Value = Str
End Sub
I would recommend using Form Control instead of ActiveX control and the reason is very simple. When you copy the button across, the link to the macro remains intact., which is also one of your requirements.
And this is the code that you can use for the CommandButton (Form Control)
Sub Button1_Click()
Dim cellAddr As String
Dim aCol As Long
'~~> Get the address of the cell
cellAddr = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
'~~> Also get the column number
aCol = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
'~~> This is required if the button is in column 1
If aCol <> 1 Then _
ActiveSheet.Range(cellAddr).Offset(, -1).Value = Date
End Sub
To point at a specific range do something like this:
Private Sub CommandButton1_Click()
Dim Str As String
Str = Date
Range("C5").Value = Str
End Sub
Alternatively use a named range i.e. give the range C5 the name "TopLeftCell"
...then you can use the following:
Private Sub CommandButton1_Click()
Dim Str As String
Str = Date
Range("TopLeftCell").Value = Str
End Sub
Something like this:
Private Sub CommandButton2_Click()
Dim r As Long, c As Long, i As Long
Dim str As String
r = Rows.Count
c = Columns.Count
str = Date
For i = 1 To r
If Cells(i, 1).Top > CommandButton2.Top Then
Exit For
End If
Next
r = i - 1 ' you have to calibrate, what fits better r = i or r = i - 1 or r = i - 2 ....
For i = 1 To c
If Cells(1, i).Left > CommandButton2.Left Then
Exit For
End If
Next
c = i - 2 ' you have to calibrate, what fits better c = i or c = i - 1 or c = i - 2 ....
Cells(r, c) = str
End Sub
This should work, but it really depends on where you place the button. Look at the lines r = i - 1 and c = i - 2.
Related
Right now, I'm developing web application using DevExpress BootstrapChart (v17.2.13.0) and I have binded the control with object datasource. Here is the example data used to be displayed in the graph:
Here is my objectives:
The graph will show the values of "ademand_im" and "rdemand_im" in different panes (I named them pane "A" and "B")
Each pane has "data_time" (date and time) as X-axis and the values ("ademand_im" or "rdemand_im") as Y-axis
Also, the values in each pane will be grouped by "hardware_id" so, in this case, there should be 2 line series of "83245551" and "88310991" in each pane (Note that "hardware_id" can be varied from time to time).
So the graph should look like this:
However, what I only acheive at this moment is that either the line series are shown in both panes but not grouped or not show anything in the graph.
Here is my code:
<dx:BootstrapChart ID="chart" ClientInstanceName="chart" runat="server"
DataSourceID="ods_ChartData" Height="640px" TitleText="Chart Data" CrosshairEnabled="true" Panes="A,B">
<ClientSideEvents Init="OnChartInit" />
<SettingsToolTip Shared="true" Enabled="true" OnClientCustomizeTooltip="ChartToolTip" />
<ArgumentAxis ArgumentType="System.DateTime" GridVisible="True" MinorGridVisible="True"
TickVisible="True" MinorTickVisible="True" TickInterval="1" MinorTickCount="3" TitleText="Date">
<Label DisplayMode="Rotate" RotationAngle="-0" Format-Formatter="FormatDate" />
</ArgumentAxis>
<ValueAxisCollection>
<dx:BootstrapChartValueAxis Pane="A" TitleText="ademand_im" />
<dx:BootstrapChartValueAxis Pane="B" TitleText="rdemand_im" />
</ValueAxisCollection>
<SettingsCommonSeries Type="Line" ArgumentField="data_time" Point-Size="0" />
<SettingsSeriesTemplate NameField="hardware_id" />
<SeriesCollection>
<dx:BootstrapChartLineSeries Pane="A" ValueField="ademand_im" />
<dx:BootstrapChartLineSeries Pane="B" ValueField="rdemand_im" />
</SeriesCollection>
</dx:BootstrapChart>
In this code, if I remove the "SettingsSeriesTemplate" line, the data will show in both panes but only in single line in each pane. However, if I keep this line the graph will not show anything.
After I tried to understand how this control works, the only solution I found is that I have to pivot "hardware_id" columns into "ademand_im" and "rdemand_im" values, which may be not the ideal one.
So instead of having "hardware_id", "ademand_im" and "rdemand_im" columns, the table should be transformed to have like "ademand_im_83245551", "ademand_im_88310991", "rdemand_im_83245551" and "rdemand_im_88310991" columns instead.
This is how the table after transforming looks like:
Here is the function codes that I used to transform the table (VB.NET):
<Extension()>
Public Function PivotDataTableColumnGroup(srcData As DataTable, rowGroupField As String, pivotColumnField As String, valueGroupFields As IEnumerable(Of String),
Optional ValueGroupColumnName As Func(Of String, String, String) = Nothing,
Optional otherFields As IEnumerable(Of String) = Nothing,
Optional GetOtherFieldValue As Func(Of DataTable, String, Object, Object) = Nothing
) As DataTable
Dim groupValueList As List(Of Object) = srcData.GetDistinctValuesByColumnName(rowGroupField)
Dim pivotValueList As List(Of Object) = srcData.GetDistinctValuesByColumnName(pivotColumnField)
Dim hasOtherFieldColumn As Boolean = Not (otherFields Is Nothing Or GetOtherFieldValue Is Nothing)
Dim dt As New DataTable
With dt
.Columns.Add(rowGroupField, srcData.Columns(rowGroupField).DataType)
For i As Integer = 0 To valueGroupFields.Count - 1
For j As Integer = 0 To pivotValueList.Count - 1
Dim columnName As String = GetColumnNameFromGroupFieldAndPivotValues(valueGroupFields(i), pivotValueList(j), ValueGroupColumnName)
dt.Columns.Add(columnName, srcData.Columns(valueGroupFields(i)).DataType)
Next
Next
If hasOtherFieldColumn Then
For i As Integer = 0 To otherFields.Count - 1
.Columns.Add(otherFields(i), srcData.Columns(otherFields(i)).DataType)
Next
End If
For i As Integer = 0 To groupValueList.Count - 1
Dim currentGroupValue As Object = groupValueList(i)
Dim dr As DataRow = dt.NewRow()
dr(rowGroupField) = currentGroupValue
If hasOtherFieldColumn Then
For j As Integer = 0 To otherFields.Count - 1
dr(otherFields(j)) = DBNullIfNothing(GetOtherFieldValue(srcData, otherFields(j), currentGroupValue))
Next
End If
For j As Integer = 0 To valueGroupFields.Count - 1
Dim currentField As String = valueGroupFields(j)
For k As Integer = 0 To pivotValueList.Count - 1
Dim currentPivotValue As Object = pivotValueList(k)
Dim columnName As String = GetColumnNameFromGroupFieldAndPivotValues(valueGroupFields(j), pivotValueList(k), ValueGroupColumnName)
Dim value As Object = (From row In srcData.AsEnumerable
Where row(rowGroupField) = currentGroupValue _
AndAlso row(pivotColumnField) = currentPivotValue
Select row(currentField)
).FirstOrDefault
dr(columnName) = DBNullIfNothing(value)
Next
Next
dt.Rows.Add(dr)
Next
End With
Return dt
End Function
<Extension()>
Public Function GetDistinctValuesByColumnName(dt As DataTable, columnName As String) As List(Of Object)
Dim valueList As List(Of Object) = (From row As DataRow In dt.AsEnumerable
Where Not IsDBNull(row(columnName))
Order By row(columnName)
Select row(columnName) Distinct
).ToList
Return valueList
End Function
Private Function GetColumnNameFromGroupFieldAndPivotValues(groupField As String, pivotValue As Object, Optional ValueGroupColumnName As Func(Of String, String, String) = Nothing) As String
Dim columnName As String = groupField & "_" & pivotValue.ToString()
If ValueGroupColumnName IsNot Nothing Then
columnName = ValueGroupColumnName(groupField, pivotValue)
End If
Return columnName
End Function
Public Function DBNullIfNothing(o As Object) As Object
If o Is Nothing Then Return DBNull.Value
Return o
End Function
And this is how I used the function to transform the table:
Dim chartData As DataTable = result.PivotDataTableColumnGroup("data_time", "hardware_id", {"ademand_im", "rdemand_im"}, Nothing, Nothing, Nothing)
ResultChartData = chartData 'Stored in ASPxHiddenField in JSON form
After that, instead of setting chart series properties in aspx file, I have to add chart series manually in code behind:
Private Sub chart_LoadProfile_DataBound(sender As Object, e As EventArgs) Handles chart_LoadProfile.DataBound
Using ResultChartData
Dim seriesList As List(Of String) = (From col As DataColumn In ResultChartData.Columns
Where col.ColumnName <> "data_time"
Order By col.ColumnName
Select col.ColumnName
).ToList
Dim hardWardCount As Integer = (From s In seriesList Where s.Contains("ademand_im_")).Count
Dim showInLegend As Boolean = hardWardCount > 1
With chart_LoadProfile.SeriesCollection
.Clear()
For i As Integer = 0 To seriesList.Count - 1
Dim fieldName As String = seriesList(i)
Dim hardwareId As String = seriesList(i).Split("_")(2)
Dim series As New BootstrapChartLineSeries
With series
.ArgumentField = "data_time"
.ValueField = fieldName
.Point.Size = 0
.ShowInLegend = showInLegend
If fieldName.Contains("ademand_im_") Then
.Pane = "A"
.Name = "kW - " & hardwareId
Else
.Pane = "B"
.Name = "kVar - " & hardwareId
End If
End With
.Add(series)
Next
End With
End Using
End Sub
I'm trying to combine the row cells when the campaign code and vehicle no are repeated as shown in below image. The result listed below is with gridview 20 page size
Problem
When the grid view page size is set with 2 for example, the row cell no longer combined. The result show each separated record.
If campaign code is sorted ascending/descending, the last record row cells will always not combine even though the campaign code and vehicle no are matched. Below image shown campaign code sorted in ascending. So when the campaign code is sorted descending, all the CMP002 are combined, while the last record of CMP001 will not be combined as shown in below image anymore.
Code Behind
Private Sub GV_RowDataBound(sender As Object, e As GridViewRowEventArgs) Handles GV.RowDataBound
For rowIndex As Integer = GV.Rows.Count - 2 To 0 Step -1
Dim gvRow As GridViewRow = GV.Rows(rowIndex)
Dim gvPreviousRow As GridViewRow = GV.Rows(rowIndex + 1)
Dim sCurrCampaignCode As String = GV.DataKeys(rowIndex).Values("CAMPAIGN_CODE")
Dim sCurrVehicleNo As String = GV.DataKeys(rowIndex).Values("VEHICLE_NO")
Dim sPreviousCampaignCode As String = GV.DataKeys(rowIndex + 1).Values("CAMPAIG_CODE")
Dim sPreviousVehicleNo As String = GV.DataKeys(rowIndex + 1).Values("VEHICLE_NO")
If sCurrCampaignCode = sPreviousCampaignCode AndAlso sCurrVehicleNo = sPreviousVehicleNo Then
If sCurrCampaignCode = sPreviousCampaignCode Then
If gvPreviousRow.Cells(1).RowSpan < 2 Then
gvRow.Cells(1).RowSpan = 2
gvRow.Cells(2).RowSpan = 2
gvRow.Cells(3).RowSpan = 2
Else
gvRow.Cells(1).RowSpan = gvPreviousRow.Cells(1).RowSpan + 1
gvRow.Cells(2).RowSpan = gvPreviousRow.Cells(2).RowSpan + 1
gvRow.Cells(3).RowSpan = gvPreviousRow.Cells(3).RowSpan + 1
End If
gvPreviousRow.Cells(1).Visible = False
gvPreviousRow.Cells(2).Visible = False
gvPreviousRow.Cells(3).Visible = False
End If
End If
Next
End Sub
I just found a solution. Code have to be moved from RowDataBound to OnDataBound instead
I want to make a class library containing classes for common tasks.
I made such a class that worked very well on some forms but it have some errors that I can't trace down.
This is my code and it does the following:
It accepts 3 parameters: form name, datagridview name and the textbox name prefixes.
It counts the datagrid columns
It takes the current row index
It makes the array with a length corresponding to the number of columns
It's looking in the form for all text boxes that have a name with prefix parameter + column name and set the value in it
Code:
Sub setRecordFieldToControl(ByVal root As Form, ByVal dgv As DataGridView, ByVal cntrlPreNam1 As String, ByVal cntrlPreNam2 As String)
Dim j, k, z As Integer
Dim s As String
z = dgv.ColumnCount
k = dgv.CurrentRow.Index
j = 0
Dim headTxt(z) As String
For indx = 0 To z - 1
headTxt(indx) = dgv.Columns(indx).HeaderText
Next
For Each i As Control In root.Controls
If TypeOf i Is MaskedTextBox Or TypeOf i Is ComboBox Then
For clm = 0 To z
If i.Name = cntrlPreNam1 & headTxt(clm) Or i.Name = cntrlPreNam1 & headTxt(clm) Then
s = (dgv.Rows(k).Cells(j).Value)
i.Text = s
' i.Text = dgv.Item(j, k).Value
j = j + 1
If j >= z Then
Exit For
End If
End If
Next
End If
Next
End Sub
My problem is: on some forms I got this error:
Index is out of range for line i.Text = s
The error does not show up when I put something else in my text box, the error only appears when I put the s in it.
The error is probably in the line
For clm = 0 To z
It should read
For clm = 0 To z - 1
The column indexes range from 0 .. number_of_columns - 1.
UPDATE
There are several problems with your code:
The logic seems wrong to me. You are looking for the column (clm) with the right name but then take the value of another column (j). Why?
The variable names are not speaking and are even misleading (e.g. i for a Control).
You have nested loops with an O(n^2) behavior. See Big O Notation.
I suggest rewriting it. Use a dictionary for the possible control names, that stores the corresponding column indexes by name. Dictionaries have a nearly constant access speed. In other words: Lookups are very fast.
Sub SetRecordFieldToControl(ByVal root As Form, ByVal dgv As DataGridView, _
ByVal cntrlPrefix1 As String, ByVal cntrlPrefix2 As String)
Dim currentRowIndex As Integer = dgv.CurrentRow.Index
Dim columnDict = New Dictionary(Of String, Integer)
For i As Integer = 0 To dgv.ColumnCount - 1
Dim headerText As String = dgv.Columns(i).HeaderText
columnDict.Add(cntrlPrefix1 & headerText, i)
columnDict.Add(cntrlPrefix2 & headerText, i)
Next
For Each cntrl As Control In root.Controls
If TypeOf cntrl Is MaskedTextBox Or TypeOf cntrl Is ComboBox Then
Dim columnIndex As Integer
If columnDict.TryGetValue(cntrl.Name, columnIndex) Then
Dim value As Object
value = dgv.Rows(currentRowIndex).Cells(columnIndex).Value
If Not value Is Nothing Then
cntrl.Text = value.ToString()
End If
End If
End If
Next
End Sub
Sorry again, experts for the bother again.but
We have a db date called orderdate.
If today's date - orderdate is less than 2 days (or 48 hours), disable Cancel Order button so user cannot cancel his or her order.
When I tried running the following code, I get Input string not in the format
Orderdate is of type datetime. However, we would like to display the date in the format of MM/dd/yyyy. Example: 6/4/2013, not 06/04/2013.
Can you please look at my code and tell me what I am doing wrong?
If dr1.Read() Then
Dim odate As String = DateTime.Parse(dr1("orderDates").ToString()).ToShortDateString()
Dim cancelBtn As New Button()
Dim dates As String = DateTime.Parse(Now().ToString()).ToShortDateString()
If (sdate - dates) <2 Then
cancelBtn.Enabled = False
Else
cancelBtn.Enabled = True
End If
End If
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As GridViewRowEventArgs)
' Create cancel training button
Dim cancelBtn As New Button()
cancelBtn.Style.Add("width", "105px")
cancelBtn.Style.Add("padding", "5px")
cancelBtn.Style.Add("margin", "5px")
'cancelBtn.Enabled = False
cancelBtn.Text = "Cancel training"
If e.Row.RowIndex > "-1" Then
' Change tracking ID to link
'Dim track As [String] = e.Row.Cells(4).Text
'If track <> " " AndAlso track.Length > 0 Then
' Dim trackLink As New Literal()
' trackLink.Text = "<a style='color: blue;' href='" + track + "'/>Track</a>"
' e.Row.Cells(4).Controls.Add(trackLink)
'End If
' Add buttons to column
Dim oid As [String] = e.Row.Cells(0).Text
Dim invoiceLink As New Literal()
invoiceLink.Text = "<a style='color: blue;' href='Invoice.aspx?oid=" + oid + "'/>" + oid + "</a>"
e.Row.Cells(0).Controls.Add(invoiceLink)
e.Row.Cells(e.Row.Cells.Count - 1).Controls.Add(cancelBtn)
' Pass order id & row to on-click event
'cancelBtn.Click += new EventHandler(this.cancelBtn_Click);
'cancelBtn.CommandArgument = e.Row.RowIndex + "-" + oid
End If
End Sub
I'm not sure why you'd want to convert your date fields into strings. I would recommend leaving those as datetime objects for your comparison. You can always manipulate the display of the dates in your presentation logic.
This is some working code leaving as dates using Subtract and TotalDays:
Dim cancelBtn As New Button()
Dim odate As DateTime = DateTime.Parse(dr1("orderDates").ToString())
Dim dates As DateTime = DateTime.Now()
If dates.Subtract(odate).TotalDays >= 2 Then
cancelBtn.Enabled = False
Else
cancelBtn.Enabled = True
End If
You could also consolidate the If statement to a single line:
cancelBtn.Enabled = dates.Subtract(odate).TotalDays < 2
EDIT: Regarding the logic, your DB field orderDates sounds like it refers to the day the order was created. That date will always be in the past, so we would be interested in Today - orderDates.
However, based on your comments it seems orderDates refers to the day the order will ship. That date must be more than 2 days in the future for the user to cancel his order, so we're interested in orderDates - Today.
I don't see where you run the order date logic inside GridView1_RowDataBound.
Private Function MoreThanTwoDaysUntilShip() As Boolean
'logic to open dr1
If dr1.Read() Then
Dim shipDate As Date = DateTime.Parse(dr1("orderDates").ToString())
Dim today As Date = Date.Now
Return shipDate.Subtract(today).TotalDays > 2
End If
Return False
End Function
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As GridViewRowEventArgs)
' Create cancel training button
Dim cancelBtn As New Button()
cancelBtn.Style.Add("width", "105px")
cancelBtn.Style.Add("padding", "5px")
cancelBtn.Style.Add("margin", "5px")
'add this
cancelBtn.Enabled = MoreThanTwoDaysUntilShip()
'etc
End Sub
DateTime.Parse(Now().ToString()).ToShortDateString()
Replace with
Today
And otherwise, don't manipulate dates in strings.
I have a problem.
Dim Maxis As String
'Dim MaxisExtra As String
Dim b As New ArrayList
Dim WS As New WebService1.Service1
Dim cnt As String
Dim MRWS As New MobileReload_WS.MobileReload_WS
cnt = WS.StockCountTelco(1, Session("Maxis"))
If CInt(cnt) >= CInt(DropDownList1.SelectedItem.Text) Then
Dim sLock As String
sLock = MRWS.LockAStock(1, 1, "Online", Session("Maxis"), DropDownList1.SelectedItem.Text)
Session("sLock") = sLock
If sLock = "" Then
PopupMsgBox("Unable to allocate Stock")
Else
Maxis = "Maxis" & ";" & Session("Maxis") & ";" & DropDownList1.SelectedItem.Text & ";" & Session("Cost")
'If MaxisExtra = "" Then
' b.Add(Maxis)
' Elseif
' MaxisExtra = MaxisExtra + Maxis
' b.Add(MaxisExtra)
'End If
End If
Else
PopupMsgBox("Not enough stock")
End If
b.Add(Maxis)
Session("Transaction") = b
End Sub
The first time i enter the string into the arraylist it is okay. But when the user press the button add again the second time, it replace the first string. Can anyone help me how to save the string into the second slot based on my coding?
If you're talking about the b ArrayList, then you're creating a new one each time and storing the new ArrayList in Session("Transaction")
Maybe you mean something like this instead...
Dim b as ArrayList = Session("Transaction")
If b Is Nothing Then
b = new ArrayList
End If
...
Session("Transaction") = b
Although it's difficult to say exactly, because your code is very messy and not clear
You put the array list in a session variable, but you never read it back. You create a new array list each time, so it will always be empty and replace the previous one.
Get the array list from the session variable if there is one:
Dim b As ArrayList = Session("Transaction")
If b Is Nothing Then b = New ArrayList