想要一个Excel进销存表格模板一张表的,谢谢!775659042

2020-05-22 科技 126阅读

这是一张进货表,采用一键导入数据库方式。

Private Sub CommandButton1_Click()

'从数据库读取供应商名称,写入名称管理器的供应商名称

'从数据库读取客户代号,写入名称管理器的客户代号

Dim rsT As New ADODB.Recordset

Dim Conn As ADODB.Connection

Dim myData As String

'Dim Arr As Object

'连接数据库

myData = ThisWorkbook.Path & "\acjxc.accdb"

Set Conn = CreateObject("ADODB.Connection") '这属于后期绑定

Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myData

Conn.ConnectionString = Conn.ConnectionString & ";Jet OLEDB:Database Password = gpflovezx@1980"

Conn.Open

'读取供应商清单

sqL = "SELECT 供应商名称 FROM GYSQD "

rsT.Open sqL, Conn, adOpenKeyset, adLockOptimistic

If rsT.RecordCount = 0 Then

MsgBox ("供应商清单为空!!!")

rsT.Close

Exit Sub

Else

Arr = rsT.GetRows

End If

rsT.Close

'输出导入结果

Range(Cells(3, 27), Cells(1000, 27)).ClearContents

For i = 0 To UBound(Arr, 2)

Cells(3 + i, 27) = Arr(0, i)

Next i

With ActiveWorkbook.Names("供应商名称")

.Name = "供应商名称"

.RefersToR1C1 = "=进!R3C27:R" & 3 + i & "C27"

.Comment = ""

End With

'读取货号

sqL = "SELECT 货号 FROM CPQD "

rsT.Open sqL, Conn, adOpenKeyset, adLockOptimistic

If rsT.RecordCount = 0 Then

MsgBox ("产品清单为空!!!")

rsT.Close

Exit Sub

Else

Arr = rsT.GetRows

End If

rsT.Close

'输出导入结果

Range(Cells(3, 28), Cells(1000, 28)).ClearContents

For i = 0 To UBound(Arr, 2)

Cells(3 + i, 28) = Arr(0, i)

Next i

With ActiveWorkbook.Names("货号")

.Name = "货号"

.RefersToR1C1 = "=进!R3C28:R" & 3 + i & "C28"

.Comment = ""

End With

'读取客户代号

sqL = "SELECT 客户代号 FROM KHQD "

rsT.Open sqL, Conn, adOpenKeyset, adLockOptimistic

If rsT.RecordCount = 0 Then

MsgBox ("客户清单为空!!!")

rsT.Close

Exit Sub

Else

Arr = rsT.GetRows

End If

rsT.Close

'输出导入结果

Range(Cells(3, 29), Cells(1000, 29)).ClearContents

For i = 0 To UBound(Arr, 2)

Cells(3 + i, 29) = Arr(0, i)

Next i

With ActiveWorkbook.Names("客户代号")

.Name = "货号"

.RefersToR1C1 = "=进!R3C29:R" & 3 + i & "C29"

.Comment = ""

End With

End Sub

这是导入数据库的代码

通过 excel+access+vba 实现小企业的进销存管理系统

声明:你问我答网所有作品(图文、音视频)均由用户自行上传分享,仅供网友学习交流。若您的权利被侵害,请联系fangmu6661024@163.com