Excel——开单系统VBA代码

Sub 清除表格()

Dim 当前编号 As Integer

Sheets("销售开单").Range("D7,D10:E19").ClearContents

当前编号 = Sheets("销售统计").Range("a1").CurrentRegion.End(xlDown).Value

Sheets("销售开单").Range("H7").Value = 当前编号 + 1

Sheets("销售开单").Range("H8").Value = Date

End Sub

Sub 存储数据()

Dim 品项数量 As Integer, 空白行 As Integer

品项数量 = WorksheetFunction.CountA(Sheets("销售开单").Range("d10:d19"))

空白行 = Sheets("销售统计").Range("a1").CurrentRegion.End(xlDown).Offset(1, 0).Row

Sheets("销售开单").Range("d10:g10").Resize(品项数量).Copy

Sheets("销售统计").Range("d" & 空白行).PasteSpecial xlPasteValues

Sheets("销售统计").Range("a" & 空白行).Resize(品项数量).Value = Sheets("销售开单").Range("h7").Value

Sheets("销售统计").Range("b" & 空白行).Resize(品项数量).Value = Sheets("销售开单").Range("h8").Value

Sheets("销售统计").Range("c" & 空白行).Resize(品项数量).Value = Sheets("销售开单").Range("d7").Value

Call 清除表格

MsgBox "数据存储完毕"

End Sub

Sub 查询单据()

Dim 单号 As Integer, 单据位置 As Integer, 品项数量 As Integer

单号 = Sheets("销售开单").Range("h7").Value

品项数量 = WorksheetFunction.CountIf(Sheets("销售统计").Range("a:a"), 单号)

Sheets("销售开单").Range("d7,d10:e19").ClearContents

If 品项数量 = 0 Then

   MsgBox "查无此单据"

   Exit Sub

Else

   单据位置 = WorksheetFunction.Match(单号, Sheets("销售统计").Range("a:a"), 0)

   Sheets("销售统计").Range("d" & 单据位置).Resize(品项数量, 2).Copy

   Sheets("销售开单").Range("d10").PasteSpecial xlPasteValues

   Sheets("销售开单").Range("h8").Value = Sheets("销售统计").Range("b" & 单据位置).Value

   Sheets("销售开单").Range("d7").Value = Sheets("销售统计").Range("c" & 单据位置).Value

End If

End Sub

Sub 存为PDF()

Dim 文件名 As String

文件名 = Format(Range("h7").Value, "00000")

Sheets("销售开单").ExportAsFixedFormat _

Type:=xlTypePDF, _

Filename:="D:\Documents\Desktop\123456\" & 文件名, _

IgnorePrintAreas:=False

End Sub