pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

vault backup: 2024-02-19 10:59:09

Browse Source
This commit is contained in:
Paul Trowbridge 2024-02-19 10:59:09 -05:00
parent 758f35cecd
commit e2533d2c45
2 changed files with 66 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
PivotShortcut.bas
View File

@ -7,10 +7,10 @@ Sub SetPivotShortcutKeys()
Call Application.MacroOptions("PERSONAL.xlsb!CollapsePvtItem", "", , , , "Z")
Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtFld", "", , , , "S")
Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtItem", "", , , , "X")
Call Application.MacroOptions("PERSONAL.xlsb!PastValues", "", , , , "V")
Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format", "", , , , "F")
Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_3dec", "", , , , "N")
Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_1dec", "", , , , "M")
'Call Application.MacroOptions("PERSONAL.xlsb!PastValues", "", , , , "V")
'Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format", "", , , , "F")
'Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_3dec", "", , , , "N")
'Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_1dec", "", , , , "M")
End Sub

62
SalesWalk.cls Normal file
View File

@ -0,0 +1,62 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "SalesWalk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cust As String
Dim bucket As String
Dim note As String
Dim r As Range
Dim req As New WinHttp.WinHttpRequest
Dim wr As String
'Exit Sub
If Not Intersect(Target, Me.Range("K:L")) Is Nothing And Target.Columns.Count <= 2 Then
For Each r In Target.Rows
cust = Sheets("Data").Cells(r.row, 3)
bucket = Sheets("Data").Cells(r.row, 11)
note = Sheets("Data").Cells(r.row, 12)
With req
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
.Open "GET", "http://usmidsap02:8085/sales_walk/write_note/" & cust & "/" & bucket & "/" & note, True
.Send
.WaitForResponse
wr = .ResponseText
End With
'Sheets("Data").Cells(r.row, 12) = wr
Next r
Else
If Target.address = "$D$1" Then
Me.UpdatePowerQuerySQL
End If
End If
End Sub
Sub UpdatePowerQuerySQL()
Dim qry As WorkbookQuery
Dim newSQL As String
basecmd = "let Source = Value.NativeQuery(PostgreSQL.Database(""usmidsap02"", ""ubm""), ""SELECT * FROM rlarp.sales_walk WHERE"", null, [EnableFolding=true]) in Source"
' Change "QueryName" to the actual name of your query
Set qry = ThisWorkbook.Queries("Query1")
' Replace the SQL query text with the new query
newSQL = Replace(basecmd, "WHERE", "WHERE dsm = '" & Sheets("Data").Cells(1, 4).value & "'")
qry.Formula = newSQL
' Refresh the query to apply the change
qry.Refresh
End Sub