I have an application written in VB6.
This application contain a file with snippet containing a foreach loop. In this loop a method is adding controls to a section (section is a region in report).
I am trying to implement a functionality where:
when theheader is added in headerSection, tt will not add theHeader again, however this snippet is unable to do that. Where am I going wrong?
For Each thisColumn As Column In theColumns
If thisColumn.Type = Column.ColumnType.Description Then
AddDescriptionColumn(thisColumn, startColumnAt, headerTop)
End If
Private Sub AddDescriptionColumn(ByVal ColumnToAdd As Column, ByRef LeftPosition As Single, ByVal HeaderTop As Single)
'Get report sections
Dim headerSection As ActiveReports.Section = _theActiveReport.Sections(PageHeaderName)
'Add column header text
Dim theHeader As New ActiveReports.Label
theHeader.Name = "lblDescription"
theHeader.Text = ColumnToAdd.DisplayCaption
theHeader.Font = ColumnToAdd.HeaderFont
theHeader.Location = New PointF(LeftPosition, HeaderTop)
theHeader.Size = New SizeF(columnWidth, _columnHeaderHeight)
If TextHeight(ColumnToAdd.DisplayCaption, theHeader.Font, columnWidth) > _columnHeaderHeight Then
theHeader.VerticalAlignment = ActiveReports.VerticalTextAlignment.Top
Else
theHeader.VerticalAlignment = ActiveReports.VerticalTextAlignment.Bottom
End If
theHeader.BackColor = Color.Transparent
theHeader.MultiLine = True
theHeader.WordWrap = True
theHeader.Visible = True
headerSection.Controls.Add(theHeader)
Related
I have a standard List View component using checkboxes, while populating its data I would like to remove the checkboxes of specific rows based on a criteria, at this moment I found no way of doing it and no alternative component to replace the listview and include checkboxes.
Private Sub Form_Load()
Dim clmX As ColumnHeader
Dim itmX As ListItem
Dim i As Integer
For i = 1 To 3
Set clmX = ListView1.ColumnHeaders.Add()
clmX.Text = "Column " & i
Next i
' Inclui 10 items com o mesmo ícone
For i = 1 To 10
Set itmX = ListView1.ListItems.Add()
itmX.SmallIcon = 1
itmX.Text = "ListItem " & i
itmX.SubItems(1) = "Subitem 1"
itmX.SubItems(2) = "Subitem 2"
If i = 2 Then
'here
'itmX.removeCheckbox
End If
Next i
End Sub
I'm using the following script with a software which reads a CheckBox using OMR and outputs the data to an XML file.
Is there a way I can change it to say if more than one box has been checked, the data output should be the first checked box in the list?
Hope this makes sense.
Any help would be appreciated.
Dim installer
q_a1= Metadata.Values("OMR_FRED_P2")
q_a2= Metadata.Values("OMR_JON_P2")
q_a3= Metadata.Values("OMR_MATT_P2")
q_a4= Metadata.Values("OMR_STEVE_P2")
If q_a1 = "Filled" Then
installer = "Fred"
End If
If q_a2 = "Filled" then
installer = "Jon"
End If
If q_a3 = "Filled" then
installer = "Matt"
End If
If q_a4 = "Filled" then
installer = "Steve"
End If
call Metadata.SetValues("CompleteBy",installer)
You could do something like this:
Dim a1Checked, a2Checked, a3Checked, a4Checked
Dim numberOfChecked
a1Checked = (q_a1 = "Filled")
a2Checked = (q_a2 = "Filled")
a3Checked = (q_a3 = "Filled")
a4Checked = (q_a4 = "Filled")
numberOfChecked = Abs(a1Checked + a2Checked + a3Checked + a4Checked)
If a1Checked Or numberOfChecked > 1 Then
installer = "Fred"
ElseIf a2Checked Then
installer = "Jon"
ElseIf a3Checked Then
installer = "Matt"
ElseIf a4Checked Then
installer = "Steve"
Else
' Decide what you want to do if none is checked.
End If
Call Metadata.SetValues("CompleteBy", installer)
In VBScript, the numeric value of a "boolean true" value is -1 and of the false value is 0.
The above code simply adds the values together. If two conditions are met, the total would be -2, then we use the Abs function to get the abstract value (i.e., returning 2 instead of -2). After that, you can easily check if two or more conditions are met by using numberofChecked > 1.
I'm trying to add records to an exisiting table called "Topics" (section as of "For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected" in the code below).
When executing the code i always get "Run-time error '3022': The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. So it goes wrong at the creation of the Autonumber in the field "ID" (= the only field that is indexed - no duplicates).
When debugging, line "TopicRecord.Update" in the code below is highlighted.
I have read several posts on this topic on this forum and on other forums but still cannot get this to work - i must be overlooking something....
Private Sub Copy_Click()
Dim JournalEntrySourceRecord, JournalEntryDestinationRecord, TopicRecord As Recordset
Dim JournalEntryToCopyFromCtl, JournalEntryToCopyToCtl, JournalEntryDateCreatedCtl, SelectedTopicsCtl As Control
Dim Counter, intI As Integer
Dim SelectedTopic, varItm As Variant
Set JournalEntryToCopyFromCtl = Forms![Copy Journal Entry]!JournalEntryToCopyFrom
Set JournalEntryToCopyToCtl = Forms![Copy Journal Entry]!JournalEntryToCopyTo
Set JournalEntryDateCreatedCtl = Forms![Copy Journal Entry]!JournalEntryDateCreated
Set JournalEntrySourceRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyFromCtl.Value)
Set JournalEntryDestinationRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyToCtl.Value)
Set SelectedTopicsCtl = Forms![Copy Journal Entry]!TopicsToCopy
Set TopicRecord = CurrentDb.OpenRecordset("Topics", dbOpenDynaset, dbSeeChanges)
With JournalEntryDestinationRecord
.Edit
.Fields("InitiativeID") = JournalEntrySourceRecord.Fields("InitiativeID")
.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
.Fields("Comment") = JournalEntrySourceRecord.Fields("Comment")
.Fields("Active") = "True"
.Fields("InternalOnly") = JournalEntrySourceRecord.Fields("InternalOnly")
.Fields("Confidential") = JournalEntrySourceRecord.Fields("Confidential")
.Update
.Close
End With
JournalEntrySourceRecord.Close
Set JournalEntrySourceRecord = Nothing
Set JournalEntryDestinationRecord = Nothing
For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected
TopicRecord.AddNew
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter) = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Next Counter
TopicRecord.Fields("JournalEntryID") = JournalEntryToCopyToCtl.Value
TopicRecord.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
TopicRecord.Update
Next SelectedTopic
TopicRecord.Close
Set TopicRecord = Nothing
End Sub
First, your Dims won't work as you expect. Use:
Dim JournalEntrySourceRecord As Recordset
Dim JournalEntryDestinationRecord As Recordset
Dim TopicRecord As Recordset
Second, it looks like you get your ID included here:
TopicRecord.Fields(Counter)
or Topic is a query that includes it somehow. Try to specify the fields specifically and/or debug like this:
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter).Value = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Debug.Print Counter, TopicRecord.Fields(Counter).Name
Next Counter
In an accounting WPF app we have a number of public DataTables that reload data once a tab is opened. This works great locally as the reports just refer to those tables..
For some more complex reports we have just set up a Web Service to run them and return a PDF... To make it easier I thought of loading these DataTables into a DataSet and then extracting them at the server end. This works perfectly the first time it's run, but then (as best as I can work out so far) it's sending the incorrect (last loaded) data for subsequent reports. Locally it still works as it should but the DataTables we are sending in the DataSet appear to not be updating. Have tried to remove the tables and re-add them again, but that just throws a 'object reference not set' the first time a DataRow is selected from a DataTable at the server.
Must be something very basic I have been missing :-(
Any ideas?
Thanks
Private Async Sub RunProfitAndLossOnServer(sender As Object, e As RoutedEventArgs)
Try
Dim StartDateTB As DateTBx = ReportBalanceSheet_Grid.FindName("BalanceSheet_StartDateTB")
Dim EndDateTB As DateTBx = ReportBalanceSheet_Grid.FindName("BalanceSheet_EndDateTB")
ReportStartDate = StartDateTB.Value
ReportEndDate = EndDateTB.Value
ReportDate = Today
ReportName = "Profit and Loss Report"
PaperLandscape = False
ReportFontSize = 8
PopupModals_ReportGenerator()
If ReportGeneratorRun = True Then
Dim vPDF() As Byte = Nothing
'Determine if the Export Dataset has already been created
If ExportDS Is Nothing Then
ExportDS = New DataSet
VariablesDT = New DataTable
With VariablesDT.Columns
.Add("Current_HOA_Name", GetType(String))
.Add("Current_HOA_ID", GetType(Integer))
.Add("ReportName", GetType(String))
.Add("ReportFontSize", GetType(Integer))
.Add("ReportStartDate", GetType(Date))
.Add("ReportEndDate", GetType(Date))
.Add("User_InternationalDate", GetType(Integer))
.Add("PaperSize", GetType(String))
.Add("PaperLandscape", GetType(Boolean))
.Add("Reports_IsSplitGL", GetType(Boolean))
.Add("Form_ID", GetType(Integer))
End With
With VariablesDT.Rows
.Add(Current_HOA_Name, Current_HOA_ID, ReportName, ReportFontSize, ReportStartDate, ReportEndDate, User_InternationalDate, PaperSize, PaperLandscape, False, Form_ID)
End With
VariablesDT.TableName = "VariablesDT"
ExportDS.Tables.Add(VariablesDT)
ResIncomeDT.TableName = "ResIncomeDT"
ExportDS.Tables.Add(ResIncomeDT)
ResIncNomDT.TableName = "ResIncNomDT"
ExportDS.Tables.Add(ResIncNomDT)
ResExpensesDT.TableName = "ResExpensesDT"
ExportDS.Tables.Add(ResExpensesDT)
ResExpNomDT.TableName = "ResExpNomDT"
ExportDS.Tables.Add(ResExpNomDT)
RevenueDT.TableName = "RevenueDT"
ExportDS.Tables.Add(RevenueDT)
ExpensesDT.TableName = "ExpensesDT"
ExportDS.Tables.Add(ExpensesDT)
RevenueNomDT.TableName = "RevenueNomDT"
ExportDS.Tables.Add(RevenueNomDT)
ExpensesNomDT.TableName = "ExpensesNomDT"
ExportDS.Tables.Add(ExpensesNomDT)
Else
ExportDS.Tables.Remove("ResIncomeDT")
ExportDS.Tables.Remove("ResIncNomDT")
ExportDS.Tables.Remove("ResExpensesDT")
ExportDS.Tables.Remove("ResExpNomDT")
ExportDS.Tables.Remove("RevenueDT")
ExportDS.Tables.Remove("ExpensesDT")
ExportDS.Tables.Remove("RevenueNomDT")
ExportDS.Tables.Remove("ExpensesNomDT")
ExportDS.Tables.Add(ResIncomeDT)
ExportDS.Tables.Add(ResIncNomDT)
ExportDS.Tables.Add(ResExpensesDT)
ExportDS.Tables.Add(ResExpNomDT)
ExportDS.Tables.Add(RevenueDT)
ExportDS.Tables.Add(ExpensesDT)
ExportDS.Tables.Add(RevenueNomDT)
ExportDS.Tables.Add(ExpensesNomDT)
ExportDS.Tables.Remove("VariablesDT")
For Each row As DataRow In VariablesDT.Rows
row("Current_HOA_Name") = Current_HOA_Name
row("current_HOA_ID") = Current_HOA_ID
row("ReportFontSize") = ReportFontSize
row("User_InternationalDate") = User_InternationalDate
row("PaperSize") = PaperSize
row("PaperLandscape") = PaperLandscape
row("Reports_IsSplitGL") = False
row("ReportStartDate") = ReportStartDate
row("ReportEndDate") = ReportEndDate
row("ReportName") = ReportName
row("Form_ID") = Form_ID
Next
ExportDS.Tables.Add(VariablesDT)
End If
Dim vImage As New LoadingImage
LoadingStarted("Uploading to xSoftware... Please wait...", vImage)
Await Task.Run(Sub()
Using vService As New Service5Client
vPDF = vService.ReturnProfitAndLossSheet(ExportDS)
End Using
End Sub)
LoadingCompleted("File uploaded to xSoftware...", "File was uploaded and PDF returned...", vImage)
Dim vFile As String = ByteToFilePath(vPDF)
If System.IO.File.Exists(vFile) Then
Dim P As New Process
With P
.StartInfo.FileName = vFile
.StartInfo.Verb = "Open"
.Start()
End With
Else
AppBoxError("The file path for the PDF is not valid!")
End If
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Throws an error at the server end if we remove and add the datatables back to the DataSet
Dim RevenueData() As DataRow = RevenueDT.Select("FormID = " & Form_ID, "Position")
Dim ExpenseData() As DataRow = ExpensesDT.Select("FormID = " & Form_ID, "Position")
Dim RevenueNomData() As DataRow = RevenueNomDT.Select("FormID = " & Form_ID, "Position")
Dim ExpenseNomData() As DataRow = ExpensesNomDT.Select("FormID = " & Form_ID, "Position")
It looks like the answer is
Remove the DataTables from the DataSet and add them again (which got us part of the way there)
Name the DataTables again!
ExportDS.Tables.Remove("ResIncomeDT")
ExportDS.Tables.Remove("ResIncNomDT")
ExportDS.Tables.Remove("ResExpensesDT")
ExportDS.Tables.Remove("ResExpNomDT")
ExportDS.Tables.Remove("RevenueDT")
ExportDS.Tables.Remove("ExpensesDT")
ExportDS.Tables.Remove("RevenueNomDT")
ExportDS.Tables.Remove("ExpensesNomDT")
ExportDS.Tables.Remove("VariablesDT")
VariablesDT.TableName = "VariablesDT"
ExportDS.Tables.Add(VariablesDT)
ResIncomeDT.TableName = "ResIncomeDT"
ExportDS.Tables.Add(ResIncomeDT)
ResIncNomDT.TableName = "ResIncNomDT"
ExportDS.Tables.Add(ResIncNomDT)
ResExpensesDT.TableName = "ResExpensesDT"
ExportDS.Tables.Add(ResExpensesDT)
ResExpNomDT.TableName = "ResExpNomDT"
ExportDS.Tables.Add(ResExpNomDT)
RevenueDT.TableName = "RevenueDT"
ExportDS.Tables.Add(RevenueDT)
ExpensesDT.TableName = "ExpensesDT"
ExportDS.Tables.Add(ExpensesDT)
RevenueNomDT.TableName = "RevenueNomDT"
ExportDS.Tables.Add(RevenueNomDT)
ExpensesNomDT.TableName = "ExpensesNomDT"
ExportDS.Tables.Add(ExpensesNomDT)
Now it appears to be working correctly :-)
I'm very new (1 week) to visual basic and basically I'm trying to automate some repetitive work, now to the point , within a number of files produced with varying data I need to format the selected range as a table (medium 9) but i'm in a block at the moment and need some help and would really appreciate it, here is what i have so far>>>>
Option Explicit
Dim strDate, strRepDate, strPath, strPathRaw , strDate2
dim dteTemp, dteDay, dteMth, dteYear, newDate, myDate
myDate = Date()
dteTemp = DateAdd("D", -1, myDate)
dteDay = DatePart("D", dteTemp)
dteMth = DatePart("M", dteTemp)
dteYear = DatePart("YYYY", dteTemp)
If (Len(dteDay) = 1) Then dteDay = "0" & dteDay
If (Len(dteMth) = 1) Then dteMth = "0" & dteMth
strDate = dteYear&"-"&dteMth&"-"&dteDay
strDate2 = dteYear&""&dteMth&""&dteDay
Dim objXLApp, objXLWb, objXLWs
Set objXLApp = CreateObject("Excel.Application")
Set objXLWb = objXLApp.Workbooks.Open("C:\Users\CuRrY\Desktop\"&strDate2&"\Agent Daily Disposition "&strDate2&".xls")
objXLApp.Application.Visible = True
'start excell
Set objXLWs = objXLWb.Sheets(1)
'objXLWs.Cells(Row, Column ).Value
With objXLWs
objXLWs.Cells(3, 1).Value = "Agent Name"
'objXLWs.Range("A3").Select
objXLWs.Range("A3").CurrentRegion.Select
'End With
as you can see i reached as far as CurrentRegion.Select but how to format selected cells into (medium 9) i've tried so much and failed
Thanks for any help
You can configure the CurrentRegion(which represents a Range object) through the SpecialCells Submethod. Although your conditions are specific to your xls sheet, you will still have to follow the formatting available through the specialcells() method properties. Also, by utilizing the currentregion property, the page assumes you have a xls header. So it is important to verify your table structure before trying to incorporate this property.
For instance:
Sub FillIn()
Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 _
= "=R[-1]C"
Range("A1").CurrentRegion.Value = Range("A1").CurrentRegion.Value
End Sub
View the available properties that can be applied to CurrentRegion -> Here
And the MSDN Article -> Here