update files
This commit is contained in:
parent
019c83c34f
commit
e3bf5bdcf5
1
fpvt.log
1
fpvt.log
@ -1 +0,0 @@
|
||||
Line 2: The Form or MDIForm name fpvt is already in use; cannot load this form.
|
55
http.bas
55
http.bas
@ -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
|
118
monthly.bas
118
monthly.bas
@ -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
|
@ -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
107
pivot.cls
@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user