price_form

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
Debug.Print "---price_form----"

Me.[subform_price].SourceObject = "subform_price"
Me.[subform_price].Form.RecordsetType = 0
Me.[subform_price].Form.RecordSource = "SELECT * FROM price_view;"

End Sub

Private Sub search_field_AfterUpdate()
filter_sub
End Sub

Private Sub in_stock_flag_AfterUpdate()
filter_sub
End Sub


Public Sub filter_sub()
Dim sql$, where$, order$
Dim i As Integer

sql$ = "SELECT GOODS.ID, GOODS.NAME, GOODS.BUY_PRICE, GOODS.SKLAD1, GOODS.SKLAD2, GOODS.LIMIT, GOODS.BOX, GOODS.BUY_PRICE * (GOODS.SKLAD1 + GOODS.SKLAD2) AS SUMMA" _
& " FROM GOODS "

where$ = " WHERE GOODS.IS_DELETED = 0"

order$ = " ORDER BY GOODS.NAME;"

If in_stock_flag Then
where$ = where$ & " AND (GOODS.SKLAD1>0 OR GOODS.SKLAD2>0)"
End If

If search_field.Value <> 0 Then
where$ = where$ & " AND Lcase(GOODS.NAME) Like '*" & check_txt(LCase(search_field.Value)) & "*'"
End If

Debug.Print where$

Me.[subform_price].Form.RecordSource = (sql$ & where$ & order$)

End Sub


Private Sub Excel_button_Click()
Debug.Print "excel_button_Click()"

Dim rs As DAO.Recordset
Set rs = Me.[subform_price].Form.RecordsetClone

If rs.BOF Then
Exit Sub
End If
DoCmd.OpenForm "modal_wait_please"

Dim oExcel As Object
Set oExcel = CreateObject("Excel.application")
oExcel.Application.Visible = False
'oExcel.Application.windowsstate = xlMaximized
oExcel.Workbooks.Add
oExcel.DisplayAlerts = False
oExcel.Caption = "Price-list"
'oExcel.ActiveSheet.PageSetup.LeftMargin = 30
'oExcel.ActiveSheet.PageSetup.RightMargin = 30
'oExcel.ActiveSheet.PageSetup.TopMargin = 30
'oExcel.ActiveSheet.PageSetup.BottomMargin = 30
'oExcel.ActiveSheet.PageSetup.Orientation = 1 ' xlPortrait
'oExcel.ActiveSheet.PageSetup.PaperSize = 9  'xlPaperA4
oExcel.Cells.Font.NAME = "Calibri"
oExcel.Cells.Font.Size = 11

With oExcel
    .Columns("A").ColumnWidth = 40
    .Columns("B").ColumnWidth = 12
    .Columns("C").ColumnWidth = 12
    .Columns("D").ColumnWidth = 12
    .Columns("E").ColumnWidth = 14
    .Columns("F").ColumnWidth = 14

    .Range("A1").Value = "Price-list"

    .Range("A4").Value = "Model"
    .Range("B4").Value = "sklad 1"
    .Range("C4").Value = "sklad 2"
    .Range("D4").Value = "BUY_PRICE"
    .Range("E4").Value = "Sum sklad 1"
    .Range("F4").Value = "Sum sklad 2"

Dim nrow As Integer
nrow = 5

rs.MoveFirst

Do While Not rs.EOF
      .Range("A" & nrow).Value = rs!NAME
      .Range("B" & nrow).Value = rs!sklad1
      .Range("C" & nrow).Value = rs!sklad2
      .Range("D" & nrow).Value = CDbl(Nz(rs!BUY_PRICE))
      .Range("E" & nrow).FormulaR1C1 = Nz(rs!sklad1) * CDbl(Nz(rs!BUY_PRICE))
      .Range("F" & nrow).FormulaR1C1 = Nz(rs!sklad2) * CDbl(Nz(rs!BUY_PRICE))

 nrow = nrow + 1

 rs.MoveNext
Loop

    .Range("D5:F" & nrow).NumberFormat = "0.00;-0.00;#"

    .Range("E" & nrow).Formula = "=SUM(E5:E" & Trim(Str(nrow - 1)) & ")"
    .Range("F" & nrow).Formula = "=SUM(F5:F" & Trim(Str(nrow - 1)) & ")"
    .Range("E5:F" & nrow).NumberFormat = "[Blue]0.00;[Red]-0.00;#"

    .Range("A5:A" & (nrow - 1)).HorizontalAlignment = xlLeft
    .Range("B4:F" & Trim(Str(nrow - 1))).HorizontalAlignment = xlCenter

'Borders
    .Range("A4:F" & (nrow - 1)).Select
    .Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    .Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With .Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With


 rs.Close
 Set rs = Nothing

  Dim Path$
  Path$ = get_path()
  Path$ = Path$ & "\price.xls"
   On Error Resume Next
   .ActiveWorkbook.SaveAs FileName:= _
        Path$, FileFormat:= _
        xlExcel8, PASSWORD:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

DoCmd.Close acForm, "modal_wait_please"
.Application.Visible = True

'Freeze Panes
.Application.ScreenUpdating = True
.Cells(5, 2).Select
.ActiveWindow.FreezePanes = True

End With

Set oExcel = Nothing

End Sub