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

snap to current personal.xlsb

Browse Source
This commit is contained in:
Paul Trowbridge 2017-11-06 13:27:09 -05:00
parent ac530a079f
commit c2ab8b5a4b
1 changed files with 27 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
FL.bas
View File

@ -6,12 +6,13 @@ Sub Determine_Active_Range()
Dim r As range Dim r As range
Dim s As String Dim s As String
Dim cell As range
Set r = Selection Set r = Selection
MsgBox (r.Address) MsgBox (r.Address)
For Each cell In r For Each cell In r.Cells
s = s & cell.value s = s & cell.value
Next cell Next cell
@ -19,18 +20,6 @@ Sub Determine_Active_Range()
End Sub End Sub
Sub BackupPersonal()
Application.DisplayAlerts = False
With Workbooks("Personal.xlsb")
.SaveCopyAs Workbooks("Personal.xlsb").Sheets("CONST").Cells(1, 2)
.Save
End With
Application.DisplayAlerts = True
End Sub
Sub Cross_Join_Selection() Sub Cross_Join_Selection()
Dim x As New TheBigOne Dim x As New TheBigOne
@ -50,7 +39,7 @@ Sub Cross_Join_Selection()
r1 = x.SHTp_Get(Excel.ActiveSheet.Name, ar.row, ar.column, False) r1 = x.SHTp_Get(Excel.ActiveSheet.Name, ar.row, ar.column, False)
Else Else
r2 = x.SHTp_Get(Excel.ActiveSheet.Name, ar.row, ar.column, False) r2 = x.SHTp_Get(Excel.ActiveSheet.Name, ar.row, ar.column, False)
r1 = x.TBLp_CrossJoin(r1, r2, False) r1 = x.TBLp_CrossJoin(r1, r2, True)
End If End If
i = i + 1 i = i + 1
Next ar Next ar
@ -67,6 +56,18 @@ Sub Cross_Join_Selection()
End Sub End Sub
Sub BackupPersonal()
Application.DisplayAlerts = False
With Workbooks("Personal.xlsb")
.SaveCopyAs Workbooks("Personal.xlsb").Sheets("CONST").Cells(1, 2)
.Save
End With
Application.DisplayAlerts = True
End Sub
Sub ExtractPNC_CSV() Sub ExtractPNC_CSV()
@ -174,11 +175,11 @@ Sub ExtractPNC_CSV()
' sh1.Name = "Collateral" ' sh1.Name = "Collateral"
' sh2.Name = "Balance" ' sh2.Name = "Balance"
If Not x.FILEp_CreateCSV("C:\users\ptrowbridge\downloads\col.csv", col) Then If Not x.FILEp_CreateCSV(Mid(p.SelectedItems(1), 1, Len(p.SelectedItems(1)) - 4) & "col.csv", col) Then
MsgBox ("error") MsgBox ("error")
End If End If
If Not x.FILEp_CreateCSV("C:\users\ptrowbridge\downloads\bal.csv", bal) Then If Not x.FILEp_CreateCSV(Mid(p.SelectedItems(1), 1, Len(p.SelectedItems(1)) - 4) & "bal.csv", bal) Then
MsgBox ("error") MsgBox ("error")
End If End If
@ -301,7 +302,7 @@ End Function
Sub json_from_table_pretty() Sub json_from_table_pretty()
Dim wapi As New Windows_API Dim wapi As New Windows_API
Dim x As New TheBigOne
Dim tbl() As Variant Dim tbl() As Variant
tbl = Selection tbl = Selection
@ -351,50 +352,13 @@ End Sub
Sub json_from_table() Sub json_from_table()
Dim wapi As New Windows_API Dim wapi As New Windows_API
Dim x As New TheBigOne
Dim tbl() As Variant Dim tbl() As Variant
tbl = Selection tbl = Selection
Dim ajson As String Call wapi.ClipBoard_SetData(x.json_from_table(tbl, "y", False))
Dim json As String
Dim r As Integer
Dim c As Integer
Dim needs_comma As Boolean
Dim needs_braces As Integer
needs_comma = False
needs_braces = 0
ajson = ""
For r = 2 To UBound(tbl, 1)
For c = 1 To UBound(tbl, 2)
If tbl(r, c) <> "" Then
needs_braces = needs_braces + 1
If needs_comma Then json = json & ","
needs_comma = True
If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & tbl(r, c)
Else
json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
End If
End If
Next c
If needs_braces > 0 Then json = "{" & json & "}"
needs_comma = False
needs_braces = 0
If r > 2 Then
ajson = ajson & "," & json
Else
ajson = json
End If
json = ""
Next r
If r > 2 Then ajson = "[" & ajson & "]"
Call wapi.ClipBoard_SetData(ajson)
End Sub End Sub
@ -582,6 +546,8 @@ Sub LoadChan()
End Sub End Sub
Sub markdown_from_table() Sub markdown_from_table()
Dim x As New TheBigOne Dim x As New TheBigOne
@ -615,14 +581,13 @@ Sub markdown_whole_sheet()
End Sub End Sub
Sub sql_from_range() Sub sql_from_range()
Dim x As New TheBigOne Dim x As New TheBigOne
Dim wapi As New Windows_API Dim wapi As New Windows_API
Dim r() As String Dim r() As String
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), False)) Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True))
End Sub End Sub