Compare commits
No commits in common. "a55b719e9495c24c66efdf4e9fc078efacdbcd17" and "48670f9ca7d00ae947a2625cdb962e4795b98e84" have entirely different histories.
a55b719e94
...
48670f9ca7
22
FL.bas
22
FL.bas
@ -541,7 +541,7 @@ Sub sql_from_range_db2_noqh()
|
||||
Dim wapi As New Windows_API
|
||||
Dim r() As String
|
||||
Selection.CurrentRegion.Select
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False, True))
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False))
|
||||
|
||||
End Sub
|
||||
|
||||
@ -561,13 +561,13 @@ Sub sql_from_range_pg_noqh()
|
||||
Dim wapi As New Windows_API
|
||||
Dim r() As String
|
||||
Selection.CurrentRegion.Select
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False))
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False))
|
||||
|
||||
End Sub
|
||||
|
||||
Sub auto_fit_range()
|
||||
|
||||
Selection.CurrentRegion.Columns.autofit
|
||||
Selection.CurrentRegion.Columns.AutoFit
|
||||
|
||||
End Sub
|
||||
|
||||
@ -824,7 +824,7 @@ Sub extract_price_matrix()
|
||||
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
||||
new_sh.Select
|
||||
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
||||
Selection.Columns.autofit
|
||||
Selection.Columns.AutoFit
|
||||
|
||||
Rows("1:1").Select
|
||||
With ActiveWindow
|
||||
@ -1045,7 +1045,7 @@ Sub extract_price_matrix_suff()
|
||||
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
||||
new_sh.Select
|
||||
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
||||
Selection.Columns.autofit
|
||||
Selection.Columns.AutoFit
|
||||
|
||||
Rows("1:1").Select
|
||||
With ActiveWindow
|
||||
@ -1294,7 +1294,7 @@ PRICELIST_SHOW:
|
||||
|
||||
'--------Open file-------------
|
||||
|
||||
If Not x.FILEp_CreateCSV(pricelist.tbPath.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
|
||||
If Not x.FILEp_CreateCSV(pricelist.tbPATH.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
|
||||
MsgBox ("error")
|
||||
End If
|
||||
|
||||
@ -1412,12 +1412,12 @@ Sub price_issues()
|
||||
If ActiveSheet.Name <> "Issues" Then Exit Sub
|
||||
|
||||
ilist = x.SHTp_Get(ActiveSheet.Name, 1, 1, True)
|
||||
sql = "MERGE INTO RLARP.ISSUES i USING (" & vbCrLf
|
||||
sql = sql & x.SQLp_build_sql_values(ilist, True, True, Db2, False, True, "N", "N", "S", "D")
|
||||
sql = sql & vbCrLf & ") x ON" & vbCrLf & " x.ordern = i.ordern" & vbCrLf & " AND x.linen = i.linen" & vbCrLf & "WHEN MATCHED THEN UPDATE SET" & vbCrLf & " i.issue = x.issue" & vbCrLf & " ,i.odate = x.odate" & vbCrLf & "WHEN NOT MATCHED THEN INSERT VALUES (" & vbCrLf & " x.ordern , x.linen, x.issue, x.odate" & vbCrLf & ")"
|
||||
sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.issues;" & vbCrLf & "INSERT INTO rlarp.issues" & vbCrLf
|
||||
sql = sql & x.SQLp_build_sql_values(ilist, True, True, PostgreSQL, False, "S", "S", "S", "S") & ";"
|
||||
sql = sql & vbCrLf & "END;"
|
||||
|
||||
|
||||
If Not x.ADOp_Exec(0, sql, 1, True, ISeries, "s7830956", False, "ptrowbridg", "qqqx53@048") Then
|
||||
If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
End If
|
||||
|
||||
@ -1659,5 +1659,3 @@ Sub clear_page_breaks()
|
||||
Next b
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
@ -490,8 +490,6 @@ Sub build_customer_files()
|
||||
Dim plev As String
|
||||
Dim effdate As Date
|
||||
Dim segment_regex As String
|
||||
Dim curr As String
|
||||
Dim fname As String
|
||||
|
||||
'----------------------pick price level---------------------------------------------------------------------
|
||||
login.Caption = "PostgreSQL Login"
|
||||
@ -597,7 +595,7 @@ Sub build_customer_files()
|
||||
segment_regex = "^F|^G|^P"
|
||||
Set nnws = nwb.Sheets.Add(, nws)
|
||||
nnws.Name = "Price List - Nursery"
|
||||
Call paste_pretty(pln, nnws, effdate, curr)
|
||||
Call paste_pretty(pln, nnws, effdate)
|
||||
End If
|
||||
End If
|
||||
|
||||
@ -615,7 +613,7 @@ Sub build_customer_files()
|
||||
End If
|
||||
Set nfws = nwb.Sheets.Add(, nws)
|
||||
nfws.Name = "Price List - Fiber"
|
||||
Call paste_pretty(plf, nfws, effdate, curr)
|
||||
Call paste_pretty(plf, nfws, effdate)
|
||||
End If
|
||||
End If
|
||||
|
||||
@ -626,7 +624,7 @@ Sub build_customer_files()
|
||||
End If
|
||||
If UBound(pl, 2) > 21 Then
|
||||
nws.Name = "Price list"
|
||||
Call paste_pretty(pl, nws, effdate, curr)
|
||||
Call paste_pretty(pl, nws, effdate)
|
||||
Else
|
||||
nws.Delete
|
||||
End If
|
||||
@ -644,13 +642,11 @@ Sub build_customer_files()
|
||||
Application.DisplayAlerts = True
|
||||
nwb.Activate
|
||||
|
||||
fname = "HC Companies Distributor Price List " & curr & ".xlsx"
|
||||
|
||||
Dim wb As Workbook
|
||||
For Each wb In Workbooks
|
||||
If wb.Name = fname Then
|
||||
If wb.Name = "HC Companies Distributor Price List.xlsx" Then
|
||||
If MsgBox("already have a price list open, close it?", vbOKCancel) Then
|
||||
Workbooks(fname).Close
|
||||
Workbooks("HC Companies Distributor Price List.xlsx").Close
|
||||
Exit For
|
||||
Else
|
||||
Exit Sub
|
||||
@ -658,10 +654,7 @@ Sub build_customer_files()
|
||||
End If
|
||||
Next wb
|
||||
|
||||
If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\" & fname
|
||||
|
||||
fname = Replace(fname, "xlsx", "pdf")
|
||||
nwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
|
||||
If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx"
|
||||
|
||||
For Each wb In Workbooks
|
||||
If wb.Name = "HC FullCode List.xlsx" Then
|
||||
@ -681,13 +674,14 @@ Sub build_customer_files()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As Date, ByRef curr As String)
|
||||
Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As Date)
|
||||
|
||||
Dim c As Range
|
||||
Dim i As Long
|
||||
Dim last As Long
|
||||
Dim lastcol As Long
|
||||
Dim j As Long
|
||||
Dim curr As String
|
||||
|
||||
nws.Activate
|
||||
nws.Cells.NumberFormat = "@"
|
||||
@ -745,7 +739,7 @@ Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As
|
||||
nws.Columns(15).WrapText = True
|
||||
nws.Columns(11).ColumnWidth = 11.71
|
||||
nws.Columns(14).ColumnWidth = 11.71
|
||||
nws.Columns(17).ColumnWidth = 13
|
||||
nws.Columns(17).ColumnWidth = 11.71
|
||||
ActiveWindow.DisplayGridlines = False
|
||||
'nws.Cells.Font.Name = "Cascadia Code Light"
|
||||
nws.Cells.Font.Name = "Courier New"
|
||||
@ -1083,11 +1077,11 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
|
||||
'-------------------force a page break on color codes----------
|
||||
j = 1
|
||||
For i = 5 To last_row
|
||||
If j >= 810 Then
|
||||
If j = 60 Then
|
||||
sheet.HPageBreaks.Add before:=sheet.Rows(i + 1)
|
||||
j = 1
|
||||
End If
|
||||
'every 73 rows is a page break for current font, but if a row is taller this needs accounted for
|
||||
'every 73 rows is a page break for current font
|
||||
If sheet.Cells(i, 18) = "colors" And sheet.Cells(i - 1, 18) <> "colors" Then
|
||||
sheet.HPageBreaks.Add before:=sheet.Rows(i)
|
||||
j = 1
|
||||
@ -1096,7 +1090,7 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
|
||||
sheet.HPageBreaks.Add before:=sheet.Rows(i)
|
||||
j = 1
|
||||
End If
|
||||
j = j + sheet.Rows(i).RowHeight
|
||||
j = j + 1
|
||||
Next i
|
||||
|
||||
sheet.DisplayPageBreaks = False
|
||||
|
||||
Loading…
Reference in New Issue
Block a user