小小出入库管理系统(2012年12月又作了更新)

zjdh

张志云 发表于 2011-10-13 08:37
楼主好强大。
但我已经用EXCEL做了1-9月的数据。现在想用楼主的。但只能键盘输入，几K行的数据啊！输死啊。 ...

为啥要逐行键盘输入？
只要将记录对应内容复制到”数据库“，基础数据对应复制到“基础信息表”就可以了。

zjdh

闻启学 发表于 2011-10-13 14:50
楼主，请问下 你的Excel 是2003还是2007 嘎1
为什么我的ListView 用不到嘎！！   我是Excel 2003 的

使用ListView，一定要引用Microsoft Windows Common Controls 6.0 (sp6)
即引用c:\WINDOWS\SYSTEM32\MSCOMCTL.OCX

zjdh

sizhen5101 发表于 2011-10-13 16:52
楼主：我的需要是不是会很麻烦啊，我这两天都在弄，蛮以为改个台头的名字就可以运行了。。。不要笑我。
1、 ...

按你的要求修改确实比较麻烦，只能等我有空再说了。
同时建议你用“出入库系统6.0”修改，增加了模糊输入等多项功能，具体你看看1楼说明。

sizhen5101

zjdh 发表于 2011-10-14 18:55
按你的要求修改确实比较麻烦，只能等我有空再说了。
同时建议你用“出入库系统6.0”修改，增加了模糊输 ...

恩，谢谢楼主，我再试试系统6.0看看

zjdh

n520 发表于 2011-10-13 20:33
烦请楼主帮我解决下，点击入库按钮后，入库表里本来没有数据，为什么还会在数据库里生存了记录，输 ...

1. Sub 入库_单击()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Application.Calculation = xlCalculationManual
   
5.     Dim irowa%, I%, MS$, RG
   
6.     If Range("E11") = "" Then MsgBox "没有输入必要的数据信息，不能添加此笔记录！" _
   
7.          & Chr(13) & Chr(13) & "请输入相应的数据！", 1 + 64, "普鑫软件工程": Exit Sub
   
8.     irowa = Sheet6.Range("E65536").End(xlUp).Row + 1
   
9.     For I = 2 To irowa
   
10.         If Range("K8").Value = Sheet6.Range("d" & I).Value Then
    
11.             If MsgBox("已经有了单据" & Range("K8").Value & "的信息,是否录入?", vbYesNo, "提示") = vbNo Then Exit Sub
    
12.         End If
    
13.     Next
    
14.     With Sheet6
    
15.         n = Range("E11").End(xlDown).Row
    
16.         If n = 17 Then n = 16
    
17.         For I = 11 To n
    
18.             .Unprotect
    
19.             .Range("e" & irowa & ":I" & irowa) = Range("E" & I & ":I" & I).Value
    
20.             .Range("a" & irowa & ":a" & irowa) = Right(Application.WorksheetFunction.Substitute([C5], " ", ""), 5)
    
21.             .Range("b" & irowa & ":b" & irowa) = Range("E8").Value
    
22.             .Range("c" & irowa & ":c" & irowa) = Range("H8").Value
    
23.             .Range("d" & irowa & ":d" & irowa) = Range("K8").Value
    
24.             .Range("J" & irowa & ":J" & irowa) = Range("J" & I & ":J" & I).Value
    
25.             .Range("L" & irowa & ":L" & irowa) = Range("K" & I & ":K" & I).Value
    
26.             .Range("M" & irowa & ":M" & irowa) = Range("K19").Value
    
27.             .Protect
    
28.             irowa = irowa + 1
    
29.         Next
    
30.     End With
    
31.     Range("E8") = ""
    
32.     Range("E11:E16").ClearContents
    
33.     'Range("F11:I16").Value = ""
    
34.     Range("J11:K16").Value = ""
    
35.     Range("K19").Value = ""
    
36.     Range("H8") = Date
    
37.     Set RG = Sheets("入库单").Range("K8")
    
38.     If Format(Range("H8"), "YYYYMMDD") <> Mid(RG, 3, 8) Then
    
39.         RG.Value = "RK" & Format(Range("H8"), "YYYYMMDD") & "0001"
    
40.     Else
    
41.         RG.Value = "RK" & Format(Range("H8"), "YYYYMMDD") & Format(Right(RG.Value, 4) + 1, "0000")
    
42.     End If
    
43.     ActiveSheet.Protect
    
44.     Application.Calculation = xlCalculationAutomatic
    
45.     Application.ScreenUpdating = True
    
46.     Application.DisplayAlerts = True
    
47. End Sub
    

复制代码

zhmould

很不错，研究研究

shihwei0809

煩請樓主幫我解決下，我使用樓主的部份程式修改，可是為什麼執行會出現 型態不符合

紅色就是會出錯的地方，再麻煩樓主幫我看一下是為什麼? 謝謝




樓主大大不用看了，我剛剛突然去找到為什麼型態不符合了


Sub FillLvw(Lvw As ListView, QueryColumn As Byte, QueryStr As String)

    Dim Arr()
    Dim Item As ListItem
    Dim r, c, i As Integer
    Dim n As Byte
    With 工作表1

c = .Range("a1").End(xlToRight).Column

r = .Range("a65536").End(xlUp).Row

If r = 1 Then Exit Sub

Arr = .Range("a2:" & Chr(64 + c) & r)

End With

Lvw.ListItems.Clear

For i = 1 To r - 1

    If InStr(1, Arr(i, QueryColumn), QueryStr) > 0 Then

        Set Item = Lvw.ListItems.Add()

            Item.Text = Arr(i, 1)

            For n = 2 To c

                Item.SubItems(n - 1) = Arr(i, n)
            Next
            Set Item = Nothing
    End If
Next


End Sub

Private Sub UserForm_Initialize()

Dim arrwidth
    Dim c, i As Integer
    With 工作表1
        c = .Range("A1").End(xlToRight).Column
        If c = 256 Then Exit Sub
        ArrCaption = .Range("a1:" & Chr(64 + c) & "1")
        
    End With
   
    ComboBox1.Style = fmStyleDropDownList
    ComboBox1.List = WorksheetFunction.Transpose(ArrCaption)
   
   
    With ListView1
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        .LabelEdit = lvwManual
       For i = 1 To c
            .ColumnHeaders.Add , , ArrCaption(1, i), arrwidth(i) - 8, 0
        Next
    End With
    Call FillLvw(ListView1, 1, "")

End Sub

zjdh

找到原因就好！

sizhen5101

老师帮看看这个，我在单据录入的项目名称上做了修改，能保存到数据库里面，但是库存表和明细账报错，如果这个能改好我就可以用了，其它的只有以后慢慢弄了

zjdh

初步修改了一下，绿色标签的工作表已修改验证过，其余你自己试吧。
出入库系统-sizhen5101.rar (239.48 KB, 下载次数: 93)

2011-10-15 21:52 上传

点击文件名下载附件