update files

This commit is contained in:
Trowbridge 2019-03-14 14:44:23 -04:00
parent 019c83c34f
commit e3bf5bdcf5
5 changed files with 4 additions and 282 deletions

View File

@ -1 +0,0 @@
Line 2: The Form or MDIForm name fpvt is already in use; cannot load this form.

View File

@ -1,55 +0,0 @@
Attribute VB_Name = "http"
Sub pull_months(doc As String)
Dim req As New WinHttp.WinHttpRequest
Dim wapi As New Windows_API
Dim wr As String
Dim json As Object
Dim i As Long
With req
.Open "GET", "http://10.56.1.108:3000/monthly_orders", True
'.Open "GET", "http://192.168.1.69:3000/monthly_orders", True
.SetRequestHeader "Content-Type", "application/json"
.Send doc
.WaitForResponse
wr = .ResponseText
End With
Call wapi.ClipBoard_SetData(wr)
'MsgBox (wr)
On Error GoTo jerr
Set json = JsonConverter.ParseJson(wr)
jerr:
If Err.Number <> 0 Then
MsgBox ("function call error:" & vbCrLf & wr)
Exit Sub
End If
On Error GoTo errh
Sheets("test").range("A2:D1000").ClearContents
Sheets("test").range("N3:Q14").ClearContents
For i = 1 To json("jsonb_agg").Count
Sheets("test").Cells(i + 1, 1) = json("jsonb_agg")(i)("oseas")
Sheets("test").Cells(i + 1, 2) = json("jsonb_agg")(i)("monthn")
Sheets("test").Cells(i + 1, 3) = json("jsonb_agg")(i)("qty")
Sheets("test").Cells(i + 1, 4) = json("jsonb_agg")(i)("sales")
Next i
Sheets("test").Select
errh:
If Err.Number <> 0 Then
MsgBox (Err.Description)
End If
End Sub

View File

@ -1,118 +0,0 @@
Sub calc_mval()
Dim pchange As Double
If IsNumeric(tbMFVal.value) Then
'calculate percent change
pchange = CDbl(tbMFVal.value) / (CDbl(tbMPAVal.value) + CDbl(tbMBaseVal.value))
'plug the adjustment required
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbMPAVal.value), "#,###")
'---------if volume adjustment method is selected, scale the volume up----------------------------------
If opmVol Then
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###")
Else
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
End If
tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###")
tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbMPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000")
Else
'tbMFVal = Format(CDbl(tbMPAVal.value) + CDbl(tbMBaseVal.value), "#,###")
tbMAVol = Format((CDbl(tbMFVol.value) - CDbl(tbMBaseVol.value) - CDbl(tbMPAVol.value)), "#,###")
tbMAPrice = 0
'tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((tbMBaseVal + tbMPAVal) / (tbMBaseVol + tbMPAVol)), "#.000")
End If
End Sub
Sub calc_mprice()
If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 Then
tbMFVal = Format(CDbl(tbMFPrice.value) * CDbl(tbMFVol.value), "#,###")
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbMPAVal.value), "#,###")
tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbMPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000")
Else
tbMFVal = 0
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbMPAVal.value), "#,###")
End If
End Sub
Sub calc_mvol()
Dim pchange As Double
If IsNumeric(tbMFVol.value) And tbMFVol <> 0 Then
'price should already have been re-calculated to base + prior at this point
tbMFVal = Format(CDbl(tbMFPrice.value) * CDbl(tbMFVol.value))
'calculate percent change
'pchange = CDbl(tbMFVal.value) / (CDbl(tbMPAVal.value) + CDbl(tbMBaseVal.value))
'plug the adjustment required
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbMPAVal.value), "#,###")
tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###")
tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbMPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000")
Else
tbMFVal = 0
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbMPAVal.value), "#,###")
tbMAPrice = Format((tbMBaseVal + tbMPAVal) / (tbMBaseVol + tbMPAVol), "#.000")
tbMAVol = Format(-CDbl(tbMBaseVol.value) - CDbl(tbMPAVol.value), "#,###")
End If
tbMFVal = Format(tbMFVal, "#,###")
End Sub
Private Sub opEditPriceM_Click()
opmVol.Enabled = False
opmPrice.Enabled = False
opmVol.Visible = False
opmPrice.Visible = False
opmPrice.value = True
opmVol.value = False
tbmfPrice.Enabled = True
tbmfPrice.BackColor = &H80000018
tbmfVal.Enabled = False
tbmfVal.BackColor = &H80000005
tbmfVol.Enabled = False
tbmfVol.BackColor = &H80000005
End Sub
Private Sub opEditSalesM_Click()
opmVol.Enabled = True
opmPrice.Enabled = True
opmVol.Visible = True
opmPrice.Visible = True
tbmfPrice.Enabled = False
tbmfPrice.BackColor = &H80000005
tbmfVal.Enabled = True
tbmfVal.BackColor = &H80000018
tbmfVol.Enabled = False
tbmfVol.BackColor = &H80000005
End Sub
Private Sub opEditVolM_Click()
opmVol.Enabled = False
opmPrice.Enabled = False
opmPrice.value = False
opmVol.value = True
opmVol.Enabled = False
opmPrice.Enabled = False
opmVol.Visible = False
opmPrice.Visible = False
tbmfPrice.Enabled = False
tbmfPrice.BackColor = &H80000005
tbmfVal.Enabled = False
tbmfVal.BackColor = &H80000005
tbmfVol.Enabled = True
tbmfVol.BackColor = &H80000018
End Sub

View File

@ -2,7 +2,7 @@ VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Sheet3"
Attribute VB_Name = "pivot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
@ -65,8 +65,10 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
scenario = "{" & handler.jsql & "}"
Call handler.load_config
Call handler.load_fpvt
nopiv:
End Sub
@ -102,3 +104,4 @@ End Function

107
pivot.cls
View File

@ -1,107 +0,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "pivot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
Exit Sub
End If
On Error GoTo nopiv
If Target.Cells.PivotTable Is Nothing Then
Exit Sub
End If
Cancel = True
Dim i As Long
Dim j As Long
Dim k As Long
Dim ri As PivotItemList
Dim ci As PivotItemList
Dim df As Object
Dim rd As Object
Dim cd As Object
Dim dd As Object
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim wapi As New Windows_API
Set ri = Target.Cells.PivotCell.RowItems
Set ci = Target.Cells.PivotCell.ColumnItems
Set df = Target.Cells.PivotCell.DataField
Set rd = Target.Cells.PivotTable.RowFields
Set cd = Target.Cells.PivotTable.ColumnFields
ReDim handler.sc(ri.Count, 1)
Set pt = Target.Cells.PivotCell.PivotTable
handler.sql = ""
handler.jsql = ""
For i = 1 To ri.Count
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'"
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
handler.sc(i - 1, 1) = ri(i).Name
Next i
scenario = "{" & handler.jsql & "}"
Call handler.load_config
Call handler.load_fpvt
nopiv:
End Sub
Function piv_pos(list As Object, target_pos As Long) As Long
Dim i As Long
For i = 1 To list.Count
If list(i).Position = target_pos Then
piv_pos = i
Exit Function
End If
Next i
'should not get to this point
End Function
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
Dim i As Integer
For i = 1 To pt.PivotFields.Count
If pt.PivotFields(i).Name = field_name Then
piv_fld_index = i
Exit Function
End If
Next i
End Function