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