deal with text box issues, div0 and escaping

This commit is contained in:
Trowbridge 2019-03-22 02:02:39 -04:00
parent 7d0ff997c1
commit 0be91dd6f8
5 changed files with 57 additions and 16 deletions

View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
Caption = "Forecast Adjustment" Caption = "Forecast Adjustment"
ClientHeight = 7260 ClientHeight = 7590
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 7215 ClientWidth = 7095
OleObjectBlob = "fpvt.frx":0000 OleObjectBlob = "fpvt.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -75,6 +75,8 @@ Private Sub butAdjust_Click()
Me.Hide Me.Hide
Set adjust = Nothing
End Sub End Sub
Private Sub butCancel_Click() Private Sub butCancel_Click()
@ -256,6 +258,7 @@ Private Sub tbFcVal_Change()
End Sub End Sub
Private Sub tbFcVol_Change() Private Sub tbFcVol_Change()
If load_tb Then Exit Sub
If opEditPrice Then calc_price If opEditPrice Then calc_price
End Sub End Sub
@ -313,11 +316,16 @@ Private Sub UserForm_Activate()
fpvt.mod_adjust = False fpvt.mod_adjust = False
pVol = 0 pVol = 0
pVal = 0 pVal = 0
pPrc = 0
bVol = 0 bVol = 0
bVal = 0 bVal = 0
bPrc = 0
aVol = 0 aVol = 0
aVal = 0 aVal = 0
aPrc = 0 aPrc = 0
fVal = 0
fVol = 0
fPrc = 0
For i = 1 To sp("package")("totals").Count For i = 1 To sp("package")("totals").Count
Select Case sp("package")("totals")(i)("order_season") Select Case sp("package")("totals")(i)("order_season")
@ -350,6 +358,9 @@ Private Sub UserForm_Activate()
Else Else
pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
End If End If
If aVal <> 0 Then
MsgBox (aVal)
End If
Me.load_mbox_ann Me.load_mbox_ann
'---------------------------------------populate monthly------------------------------------------------------- '---------------------------------------populate monthly-------------------------------------------------------
@ -646,7 +657,8 @@ End Sub
Sub calc_price() Sub calc_price()
If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then 'If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
'capture currently changed item 'capture currently changed item
fVol = tbFcVol.value fVol = tbFcVol.value
fPrc = tbFcPrice.value fPrc = tbFcPrice.value
@ -657,9 +669,14 @@ Sub calc_price()
If nomonth Then If nomonth Then
aPrc = fVal / fVol - bPrc aPrc = fVal / fVol - bPrc
Else Else
aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol)) If (bVol + pVol) = 0 Then
aPrc = 0
Else
aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
End If
End If End If
Else Else
fVol = co_num(tbFcVol.value, 0)
fVal = 0 fVal = 0
aVal = fVal - bVal - pVal aVal = fVal - bVal - pVal
End If End If

BIN
fpvt.frx

Binary file not shown.

View File

@ -207,6 +207,11 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Dim j As Integer Dim j As Integer
Dim str() As String Dim str() As String
If doc = "" Then
fail = True
Exit Function
End If
Set json = JsonConverter.ParseJson(doc) Set json = JsonConverter.ParseJson(doc)
server = Sheets("config").Cells(1, 2) server = Sheets("config").Cells(1, 2)
@ -390,14 +395,18 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
If sh.Cells(i, 7) <> 0 Then If sh.Cells(i, 7) <> 0 Then
sh.Cells(i + 1, 7) = sh.Cells(i, 7) sh.Cells(i + 1, 7) = sh.Cells(i, 7)
Else Else
sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2)) If pkg(13, 1) + pkg(13, 2) = 0 Then
sh.Cells(i + 1, 7) = 0
Else
sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
End If
End If End If
Else Else
sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2) sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
End If End If
'--adjust-- '--adjust--
If (pkg(i, 3) + pkg(i, 2)) = 0 Then If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
sh.Cells(i + 1, 8) = 0 sh.Cells(i + 1, 8) = 0
Else Else
sh.Cells(i + 1, 8) = (pkg(i, 7) + pkg(i, 6)) / (pkg(i, 3) + pkg(i, 2)) - (pkg(i, 6) / pkg(i, 2)) sh.Cells(i + 1, 8) = (pkg(i, 7) + pkg(i, 6)) / (pkg(i, 3) + pkg(i, 2)) - (pkg(i, 6) / pkg(i, 2))
@ -414,7 +423,11 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
If sh.Cells(i, 10) <> 0 Then If sh.Cells(i, 10) <> 0 Then
sh.Cells(i + 1, 10) = sh.Cells(i, 10) sh.Cells(i + 1, 10) = sh.Cells(i, 10)
Else Else
sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2)) If pkg(13, 1) + pkg(13, 2) = 0 Then
sh.Cells(i + 1, 10) = 0
Else
sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
End If
End If End If
Else Else
sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4) sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
@ -441,6 +454,7 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
months.load_sheet months.load_sheet
End Sub End Sub
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant

View File

@ -325,6 +325,7 @@ Sub load_sheet()
Call Me.crunch_array Call Me.crunch_array
Call Me.set_sheet Call Me.set_sheet
Call Me.print_basket Call Me.print_basket
Call Me.set_format
End Sub End Sub
@ -843,6 +844,10 @@ Sub new_part()
part.Show part.Show
If Not part.useval Then
Exit Sub
End If
dumping = True dumping = True
Worksheets("month").Range("B33:Q10000").ClearContents Worksheets("month").Range("B33:Q10000").ClearContents
@ -863,7 +868,7 @@ Sub new_part()
i = i + 1 i = i + 1
Loop Loop
i = i - 1 i = i - 1
If i = -1 Then i = 0
ReDim b(i, 3) ReDim b(i, 3)
i = 0 i = 0
Do Until Worksheets("month").Cells(33 + i, 2) = "" Do Until Worksheets("month").Cells(33 + i, 2) = ""

View File

@ -46,7 +46,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean
Set rd = target.Cells.PivotTable.RowFields Set rd = target.Cells.PivotTable.RowFields
Set cd = target.Cells.PivotTable.ColumnFields Set cd = target.Cells.PivotTable.ColumnFields
ReDim handler.sc(ri.Count, 1) ReDim handler.sc(ri.Count, 1)
Set pt = target.Cells.PivotCell.PivotTable Set pt = target.Cells.PivotCell.PivotTable
@ -56,19 +55,17 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean
For i = 1 To ri.Count For i = 1 To ri.Count
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND " If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & "," If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'" handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape(ri(i).Name) & "'"
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """" jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape(ri(i).Name) & """"
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
handler.sc(i - 1, 1) = ri(i).Name handler.sc(i - 1, 1) = ri(i).Name
Next i Next i
scenario = "{" & handler.jsql & "}" scenario = "{" & handler.jsql & "}"
Call handler.load_config Call handler.load_config
Call handler.load_fpvt Call handler.load_fpvt
nopiv: nopiv:
End Sub End Sub
@ -100,6 +97,14 @@ Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
End Function End Function
Function escape(ByVal text As String) As String
text = Replace(text, "'", "''")
text = Replace(text, """", """""")
escape = text
End Function