How to set font-size dynamically for all field in crystal report so that using one parameter user can change font-size of whole report ?
You can do it for all fields / texts. See below:
aa = Report.Sections.Item("D").ReportObjects.Count
For i = 1 To aa
Set crxFieldObject = Report.Sections.Item("D").ReportObjects.Item(i)
bb = crxFieldObject.Name
If Mid(bb, 1, 5) = "Field" Then
cc = Val(Mid(bb, 6))
For j = 1 To NumberOfFields 'your value
If cc = xxxxx Then 'if your condition
crxFieldObject.suppress = False
crxFieldObject.Left = Leftxxxx 'your value
crxFieldObject.Top = Topxxxx 'your value
crxFieldObject.Font.Size = Fontsizexxxx 'your value
TenPointHeight = 221 'you can change this, too
If crxFieldObject.Font.Size = 10 Then
crxFieldObject.Height = TenPointHeight
Else
crxFieldObject.Height = TenPointHeight * crxFieldObject.Font.Size / 10
End If
End If
Next j
End If
Next i
Related
On checking for condition gap(high-low) > 0.1%(which is met multiple times), the label only gets
rendered ONCE (instead of on relevant bars within 25 bar lookback).
Plz provide a solution.
CODE :
Historical Bars
//#version=5
indicator("PriceMomemtum",overlay = true,max_bars_back = 25)
gap = (math.abs(high - low)/low ) * 100
//var gap = (math.abs(high - low)/low ) * 100
if gap > 0.1
var lbl = label.new(x = bar_index,y = na , text = na ,text_font_family = font.family_default ,xloc = xloc.bar_index,yloc =yloc.abovebar,style = label.style_arrowdown ,textcolor = color.white,size =size.small,textalign = text.align_left,tooltip = na)
label.set_text(lbl,str.tostring(gap,"#.00")+"%")
label.set_xy(lbl,bar_index,high )
Realtime Bars
//#version=5
indicator("PriceMomemtum",overlay = true,max_bars_back = 25)
if barstate.isrealtime
gap = (math.abs(high - low)/low ) * 100
//var gap = (math.abs(high - low)/low ) * 100
if gap > 0.1
var lbl = label.new(x = bar_index,y = na , text = na ,text_font_family = font.family_default ,xloc = xloc.bar_index,yloc =yloc.abovebar,style = label.style_arrowdown ,textcolor = color.white,size =size.small,textalign = text.align_left,tooltip = na)
label.set_text(lbl,str.tostring(gap,"#.00")+"%")
label.set_xy(lbl,bar_index,high )
alert(str.tostring(time(syminfo.timezone)) + "(PriceMomentum)", alert.freq_once_per_bar)
Have you tried defining "lbl" variable without "var"?
result
i have problems regarding passing value with formatting issues.
The description i have put in the codes as i am having problem passing my PreEditedCheque in my code for the if ValidateMMonCheque <> MM part. The output for if length(RawChequenumber) = 15 will be in 1 digit instead of 00001 ( example)
MM = HostGetFLD('','MM')
YY = HostGetFLD('','YY')
PreEditedCheque = substr(RawChequenumber,11,5)
ValidateMMonCheque = substr(RawChequenumber,7,2)
if ValidateMMonCheque <> MM Then *From this statement*
Do
PreEditedCheque = substr('00000',1,5) *This part where those 0 can't be properly shown if pass to the next statement*
EditedCheque = '00'||'2'||'0'||YY||MM||'00'||PreEditedCheque
rc = message(2,2,EditedCheque)
End
if length(RawChequenumber) = 15 Then
EditedCheque = '00'||'2'||'0'||YY||MM||'00'||PreEditedCheque + 1 *Second statement if <>MM ran, this part, the PreEditedCheque will be not in 00001, it will be 1.
rc = PanSetCtlData('PREVIEW',EditedCheque)
What you're asking for is to have the cheque number padded to the left with zeroes in a 5-character field. The Right() function is your friend:
Right(PreEditedCheque, 5, '0') /* "1" -> "00001" */
I am somewhat new to vba, and I'm trying to create a somewhat more complex conditional format than access 2013 allows from the conditional formatting menu. I have a form with 22 target date and actual date fields. for each pair I need to:
if the target date is more than 7 days in the future, color it green.
If the target date is less than 7 days in the future or is today, color it yellow
If the target date in the past, color it red.
UNLESS there is an actual date it was accomplished, in which case:
If the actual date is before the target date, color both dates green
If the actual date is after the target date, color both dates red.
Because I have to do this on form load, and on the change of any date field (the target dates are calculated, but will change if other data is changed in the form), I wanted to write a public sub that takes form name, target date, and actual date as variables. I was able to code each box to do this on the local form module with 'Me.txtbox'
However, when I try to reference the form and text boxes from the public sub, it seems like I'm not properly referencing the text boxes on the form. I've tried 3 or 4 different ways of doing this (string, textbox.name, etc) and I feel like I'm close, but ...
Code that works as desired in the form module
Private Sub txtFreqReqDate_AfterUpdate()
If Me.txtFreqReqDate <= Me.txtFreqReq Then
Me.txtFreqReq.Format = "mm/dd/yyyy[green]"
Me.txtFreqReqDate.Format = "mm/dd/yyyy[green]"
ElseIf Me.txtFreqReqDate > Me.txtFreqReq Then
Me.txtFreqReq.Format = "mm/dd/yyyy[red]"
Me.txtFreqReqDate.Format = "mm/dd/yyyy[red]"
ElseIf IsNull(Me.txtFreReqDate) = True Then
If Me.txtFreqReq < Now() Then
Me.txtFreqReq.Format = "mm/dd/yyyy[red]"
ElseIf Me.txtFreqReq >= (Now()+7) Then
Me.txtFreqReq.Format = "mm/dd/yyyy[yellow]"
ElseIf Me.txtFreqReq > (Now()+7) Then
Me.txtFreqReq.Format = "mm/dd/yyyy[green]"
Else
Me.txtFreqReq.Format = "mm/dd/yyyy[black]"
End If
Else
Exit Sub
End If
End Sub
Perhaps not the prettiest, but I'm always open to constructive criticism. I'd have to write this 22+ times for each pair, changing the name of the text boxes each time. I want to write a public sub that just takes the names of the text boxes, but I can't seem to find the right combination:
Private Sub txtFreqReqDate_AfterUpdate()
FormatBoxes(Me, me.txtFreqReqDate, me.txtFreqReq)
End Sub
And in another module:
Public Sub FormatBoxes(CurrentForm As Form, txtActual as Textbox, txtTarget as Textbox)
frmName = CurrentForm.name
tbActual = txtActual.Name
tbTarget = txtTarget.Name
If frmName.tbActual <= frmName.tbTarget Then
frmName.tbTarget.Format = "mm/dd/yyyy[green]"
frmName.tbActual.Format = "mm/dd/yyyy[green]"
ElseIf frmName.tbActual > frmName.tbTarget Then
frmName.tbTarget.Format = "mm/dd/yyyy[red]"
frmName.tbActual.Format = "mm/dd/yyyy[red]"
ElseIf IsNull(frmName.tbActual) = True Then
If frmName.tbTarget < Now() Then
frmName.tbTarget.Format = "mm/dd/yyyy[red]"
ElseIf frmName.tbTarget >= (Now()+7) Then
frmName.tbTarget.Format = "mm/dd/yyyy[yellow]"
ElseIf frmName.tbTarget > (Now()+7) Then
frmName.tbTarget.Format = "mm/dd/yyyy[green]"
Else
frmName.tbTarget.Format = "mm/dd/yyyy[black]"
End If
Else
Exit Sub
End If
End Sub
Sorry if this is a bit long, I'm just at my wit's end...
Also, apologies for any typos. I had to re-type this from another machine.
You can simply use the textbox parameters directly in your sub.
It is not even necessary to pass the form as parameter.
Public Sub FormatBoxes(txtActual as Textbox, txtTarget as Textbox)
If txtActual.Value <= txtTarget.Value Then
txtTarget.Format = "mm/dd/yyyy[green]"
etc.
Note that when calling it, you need either Call or remove the parentheses.
Private Sub txtFreqReqDate_AfterUpdate()
Call FormatBoxes(me.txtFreqReqDate, me.txtFreqReq)
' or
' FormatBoxes me.txtFreqReqDate, me.txtFreqReq
End Sub
CurrentForm.name is a string. It is the Name property of the CurrentForm object. The CurrentForm object also has a controls collection in which the texboxes live. You can refer to them by name in there like CurrentForm.Controls("tbTarget") but you can also say CurrentForm.tbTarget. So you're very close and on the right track.
Change
frmName = CurrentForm.name
tbActual = txtActual.Name
tbTarget = txtTarget.Name
to
set frmName = CurrentForm
if frmName is not nothing then
set tbActual = txtActual
set tbTarget = txtTarget
end if
Alternatively if your signature on your method is
Public Sub FormatBoxes(CurrentForm As string, txtActual as string, txtTarget as string)
then your set up will look like
set frmName = forms(CurrentForm)
if frmName is not nothing then
set tbActual = frmName.controls(txtActual)
set tbTarget = frmName.controls(txtTarget)
end if
But I think the first one will work better.
I wanted to post the finished code to help out anyone else who searches for this subject. I did a couple thins to make this sub more universal.
First, Instead of using the date format, I only changed the .ForeColor, allowing me to use this sub for any type of textbox.
Public Sub FormatBoxes(txtActual As TextBox, txtTarget As TextBox, chkRequired As CheckBox, _
Optional intOption as Integer)
Dim intRed As Long, intYellow As Long, intGreen As Long, inBlack As Long, intGray As Long
intBlack = RGB(0, 0, 0)
intGray = RGB(180, 180, 180)
intGreen = RGB (30, 120, 30)
intYellow = RGB(217, 167, 25)
intRed = RGB(255, 0, 0)
If (chkRequired = False) Then
txtTarget.ForeColor = intGray
txtActual.ForeColor = intGray
If intOption <> 1 Then
txtTarget.Enabled = False
txtActual.Enabled = False
txtTarget.TabStop = False
txtActual.TabStop = False
End If
Else
If intOption <> 1 Then
txtTarget.Enabled = True
txtActual.Enabled = True
txtTarget.Locked = True
txtActual.Locked = False
txtTarget.TabStop = False
txtActual.TabStop = True
End If
If IsBlank(txtActual) = True Then
If txtTarget < Now() Then
txtTarget.ForeColor = intRed
ElseIf txtTarget > (Now() + 7) Then
txtTarget.ForeColor = intGreen
ElseIf txtTarget >= Now() And txtTarget <= (Now() +7) Then
txtTarget.ForeColor = intYellow
Else
txtTarget.ForeColor = intBlack
End If
ElseIf intOption - 1 Then
txtTarget.ForeColor = intBlack
txtActual.ForeColor = intBlack
ElseIf txtActual <= txtTarget Then
txtTarget.ForeColor = intGreen
txtActual.ForeColor = intGreen
ElseIf txtActual > txtTarget Then
txtTarget.ForeColor = intRed
txtActual.ForeColor = intRed
End If
End If
End Sub
In case you were wondering, IsBlank() is a function that checks for a null or zero length string:
Public Function IsBlank(str_in As Variant) As Long
If Len(str_in & "") = 0 Then
IsBlank = -1
Else
IsBlank = 0
End If
End Function
Thanks for all the help, and I hope this is useful for someone.
I want to disable/enable a checkbox in an excel sheet using vba based on the value/conditon of another checkbox. I cannot use the checkbox name, I want to use it's cell location in reference to the cell location of the checkbox that is enabling/disabling it. something like this:
Sub Software2()
Dim myRange As Range
Set myRange = Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address)
If ActiveSheet.Shapes(Application.Caller).ControlFormat.Value = 1 Then
myRange.Interior.ColorIndex = 35
myRange.Offset(0, 1).Interior.ColorIndex = 35
myRange.Offset(0, 2).Interior.ColorIndex = 35
myRange.Offset(1, 1).Interior.ColorIndex = 44
myRange.Offset(1, 2).Interior.ColorIndex = 44
myRange.Offset(2, 1).Interior.ColorIndex = 44
myRange.Offset(2, 2).Interior.ColorIndex = 44
Else
myRange.Interior.ColorIndex = 44
myRange.Offset(0, 1).Interior.ColorIndex = 44
myRange.Offset(0, 2).Interior.ColorIndex = 44
myRange.Offset(1, 1).Interior.ColorIndex = 0
myRange.Offset(1, 2).Interior.ColorIndex = 0
myRange.Offset(2, 1).Interior.ColorIndex = 0
myRange.Offset(2, 2).Interior.ColorIndex = 0
'ActiveSheet.Shapes(location of other checkbox).ControlFormat.Enabled = 0
'ActiveSheet.Shapes(location of other checkbox).ControlFormat.Enabled = 0
End If
End Sub
Here's a demo of how to find a control by its position relative to a range.
TopLeftCell is a bit finicky since the control might drift a bit to the top and/or left and so not get found. Using relative Top/Left position is a bit more robust.
You could even combine the two - depends on the relative size of the cell and the control.
Option Explicit
Sub Tester()
Dim cb
Set cb = GetControlFromRange(Range("B6"))
If Not cb Is Nothing Then
Debug.Print cb.Name
'toggle enabled
With cb.ControlFormat
.Enabled = Not .Enabled
End With
End If
End Sub
Function GetControlFromRange(rng As Range) As Object
Const POS_DELTA_MAX As Long = 10
Dim c As Object, s As Shape
For Each s In rng.Parent.Shapes
If s.Type = msoFormControl Then
'using TopLeftCell
' If Not Application.Intersect(s.TopLeftCell, rng) Is Nothing Then
' Set c = s
' Exit For
' End If
'using position
If Abs(s.Top - rng.Top) < POS_DELTA_MAX And _
Abs(s.Left - rng.Left) < POS_DELTA_MAX Then
Set c = s
Exit For
End If
End If
Next s
Set GetControlFromRange = c
End Function
Hi i inherited a load of old classic ASP code that makes some updates to some tables in what i think was old MS access db.
The databases have now been converted to SQL and work OK, however i have a need to convert some old ASP code to the equivalent TSQL. TSQL is NOT my strong point and would appreciate some help converting the vb script to the equivalent TSQL for a stored procedure called 'UpdateCircuitOrdersComments' its not the basic syntax i'm struggling with, its more what can be done IE FOR's IF's Cases, loops etc in order to achieve the below in sql.
I know the code below is not great or could be done far better, but that's what i inherited sorry.
Every field is available to me via c# parameters passed to the sproc using ajax apart from the "Contract Period"
Looking forward to learning from any sound advice from you guys...
The script is below:
Dim connect2, Class2, Query2, Counter
Dim indate1, indate2, indate3, aday1, amonth1, ayear1, aday2, amonth2, ayear2, aday3, amonth3, ayear3, length, maintrate, equiprate, stqrrate, startserial, liveserial, endserial
Dim splitArray
Set Connect = Server.CreateObject("ADODB.Connection")
Connect.Open QuotebaseDB
Set Class1 = Server.CreateObject("ADODB.Recordset")
Query = "SELECT * FROM circuits WHERE ID=" & Request("ID")
Class1.Open Query,Connect,adOpenDynamic,adLockOptimistic
if Class1("Contract Period") <> "" Then
length = Class1("Contract Period")
splitArray = split(length, " ")
length = CInt(splitArray(0))
else
length = 1
end if
Class1("actual live date") = Request("actuallivedate")
Class1("lastupdater") = Session("username")
Class1("lastupdate") = Date()
Class1("Contract Period") = length
Class1.Update
'=========================================
' Add Rate Information - Based On Actuals
'=========================================
indate1 = Request("actuallivedate")
indate2 = Request("actuallivedate")
indate3 = Request("actuallivedate")
aday1 = Left(indate1, 2)
amonth1 = Mid(indate1, 4, 2)
ayear1 = Right(indate1, 2)
aday2 = Left(indate2, 2)
amonth2 = Mid(indate2, 4, 2)
ayear2 = Right(indate2, 2)
aday3 = Left(indate3, 2)
amonth3 = Mid(indate3, 4, 2)
ayear3 = Right(indate3, 2) + length
startserial = dateserial(ayear1, amonth1, aday1)
liveserial = dateserial(ayear2, amonth2, aday2)
endserial = dateserial(ayear3, amonth3, aday3)
'========================================================
' Check that current maintenance rate will be superseded
'========================================================
Dim MaintConnect1, MaintRS1, MaintQuery1
Set MaintConnect1 = Server.CreateObject("ADODB.Connection")
MaintConnect1.Open QuotebaseDB
Set MaintRS1 = Server.CreateObject("ADODB.Recordset")
MaintQuery1 = "SELECT * FROM maintenancetable WHERE CircuitID=" & Request("ID")
MaintRS1.Open MaintQuery1,MaintConnect1,adOpenDynamic,adLockOptimistic
Do while not MaintRS1.eof
If (MaintRS1("startdate") < startserial) OR (MaintRS1("enddate") > endserial) Then
MaintRS1("startdate") = StartSerial
MaintRS1("enddate") = EndSerial
MaintRS1("circuitnum") = Class1("circuit number")
MaintRS1("modifieddate") = now
MaintRS1.Update
End If
MaintRS1.movenext
Loop
MaintRS1.close
set MaintRS1 = nothing
MaintConnect1.close
set MaintConnect1 = nothing
'========================================================
' Check that current equipment rate will be superseded
'========================================================
Dim EquipConnect1, EquipRS1, EquipQuery1
Set EquipConnect1 = Server.CreateObject("ADODB.Connection")
EquipConnect1.Open QuotebaseDB
Set EquipRS1 = Server.CreateObject("ADODB.Recordset")
EquipQuery1 = "SELECT * FROM [equipment table] WHERE CircuitID=" & Request("ID")
EquipRS1.Open EquipQuery1,EquipConnect1,adOpenDynamic,adLockOptimistic
Do while not EquipRS1.eof
If (EquipRS1("startdate") < startserial) OR (EquipRS1("enddate") > endserial) Then
EquipRS1("startdate") = StartSerial
EquipRS1("enddate") = EndSerial
EquipRS1("circuitnum") = Class1("circuit number")
EquipRS1("modifieddate") = now
EquipRS1.Update
End If
EquipRS1.movenext
Loop
EquipRS1.close
set EquipRS1 = nothing
EquipConnect1.close
set EquipConnect1 = nothing
'========================================================
' Check that current rental rate will be superseded
'========================================================
Dim STQRConnect1, STQRRS1, STQRQuery1
Set STQRConnect1 = Server.CreateObject("ADODB.Connection")
STQRConnect1.Open QuotebaseDB
Set STQRRS1 = Server.CreateObject("ADODB.Recordset")
STQRQuery1 = "SELECT * FROM STQRtable WHERE CircuitID=" & Request("ID")
STQRRS1.Open STQRQuery1,STQRConnect1,adOpenDynamic,adLockOptimistic
Do while not STQRRS1.eof
If (STQRRS1("startdate") < startserial) OR (STQRRS1("enddate") > endserial) Then
STQRRS1("startdate") = StartSerial
STQRRS1("enddate") = EndSerial
STQRRS1("circuitnum") = Class1("circuit number")
STQRRS1("modifieddate") = now
STQRRS1.Update
End If
STQRRS1.movenext
Loop
STQRRS1.close
set STQRRS1 = nothing
STQRConnect1.close
set STQRConnect1 = nothing
'===========================================
' Update Connection Charge As A One Off Charge
'===========================================
Dim OneConnect, OneRS, OneQuery
Set OneConnect = Server.CreateObject("ADODB.Connection")
OneConnect.Open QuotebaseDB
Set OneRS = Server.CreateObject("ADODB.Recordset")
OneQuery = "SELECT * FROM OneOffCharges WHERE chargetype = 'Connection Charge' and CircuitID=" & Request("ID")
OneRS.Open OneQuery,OneConnect,adOpenDynamic,adLockOptimistic
If not oners.eof Then
OneRS("chargedate") = startserial
OneRS("modifieddate") = now
OneRS("chargetype") = "Connection Charge"
OneRS.Update
End If
OneRS.close
set OneRS = nothing
OneConnect.close
set OneConnect = nothing
Class1.close
set Class1 = nothing
Connect.close
set Connect = nothing
The loops don't appear to do much other then iterate over the record set. It is unlikely that you will need to do this in T-SQL as you can probably deduce everything from queries.
Most of it just looks like update statements
-- Check that current maintenance rate will be superseded
UPDATE maintenancetable
SET StartDate = #startSerial,
EndDate = #endSerial,
CircuitNum = #circuitNumber,
ModifiedDate = CURRENT_TIMESTAMP
WHERE CircuitID=#circuitId
AND (Startdate < #startSerial OR EndDate > #endSerial)
The contract period is a bit confusing it seems to be getting the first item of an array so maybe this is the equivalent of
SELECT TOP 1 ContractPeriod FROM circuits WHERE ID=#id
-- ? ORDER BY ContractPeriod ?