仓库进销存分享

EH458059148

子墨l 发表于 2019-7-10 17:28
您好，原来的版本“进销存”表格是全的，但是您这一版本确是统计的不全，入库没发生的好像统计不到，您能帮 ...

今天抽空看了一下，你说表里不全，查了一下，你用管理员登录进"系统设置"找到"进销存"字下面"过滤无进出数据"前的勾去掉即可，我上次好想勾选了，因为此软件，我目前只用于对发票，不要各类报表所以没注意，不好意思

zhang257342

能否再加一个生产订单管理的页面

EH458059148

zhang257342 发表于 2019-9-1 20:37
能否再加一个生产订单管理的页面

目前不考虑，因为我目前是仓库工作，只修该和增加了一些功能，最主要是没有接触过订单管理方面，论坛里好想有带订单的仓库软件，你可以搜一下

LWB87819018

楼主，为什么会出现进销报表中成本合计与进出统计成本合计出现不符呢

xhbin

下载了，谢谢分享！

EH458059148

LWB87819018 发表于 2019-10-26 11:10
楼主，为什么会出现进销报表中成本合计与进出统计成本合计出现不符呢

我试了好几个，我这里正确的， ，我没有改原作者的数据，只是在他的基础上增加和修改了一些地方而以，你说的不对，可以在各报表里，在"设置单元格式"，改成"常规"，或小数点多搞几个，因原作者在"数值"只设置了2位小数，(比如你单价打进去的是3位，但显示只有2位，但在"编制栏"里显示你打的单价，这是原作者只搞了保留二位小数)你自己可以根据情况增加，或直接搞成"常规"即可，我目前只是对发票时用的，里面的报表暂时不需要，但我听说在原作者中下载的说没有错，而我这边没有改他的数据，你先按我上面改一下，应改就好 了。

iris00

这个改良版下载学习下！感谢楼主无私分享！

350977106

原作者明细表是不同意修改的，双击不可以修改，感觉这个功能是加强数据保护的，个人认为很好。但发现不双击的情况下是可以修改的。所以加进了以下的代码，进行了限制。数据只能通过出入库单进行修改。代码如下；
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next  '出现错误继续
    If Target.Column > 22 Then Exit Sub
    Application.EnableEvents = False
    If Range("Y" & Target.Row) = "数据行" Then
        MsgBox "数据行禁止修改!"
        Application.Undo
    End If
    Application.EnableEvents = True
   
End Sub

350977106

在楼主的作品上作了一些修改，个人认为是更完善了，不知能否得到楼主的首肯。
1、增加了个主界面指向图标，指向发票核对。
2、可以对发票核对表进行查询操作，查询结果置顶显示，查询结束，恢复正常顺序。
3、加强了数据保护，明细表不论单击或双击，都不能修改。修改只能进入出入单，查询原始单据修改。
4、出入库单增加了发票编号和发票日期两项。
为实现以下功能，相应代码也作了一些修改，如下：
1、发票查询
Sub 发票查询()


lastr = ActiveSheet.UsedRange.Rows.Count
For i = lastr To 6 Step -1
If Cells(i, 2) = "" Then
Rows(i).Delete Shift:=xlUp
End If
Next



p = Sheets("fapiao-hedui").Cells(Rows.Count, "b").End(xlUp).Row

Range("A6:Q" & p).Interior.Color = RGB(204, 232, 207)
Range("A6:Q" & p).Font.Color = vbBlack
Range("R:s").Font.Color = RGB(204, 232, 207)

Range("R:s") = ""

n = 0

For m = 6 To p


Range("a" & m) = m - 5
Range("s" & m) = Range("A" & m)


If Range("b" & m) = Range("b4") And Range("b4") <> "" Then
  Cells(m, 2).Interior.ColorIndex = 4
Range("r" & m) = 1
Range("s" & m) = 0
n = n + 1
End If

If Range("c" & m) = Range("c4") And Range("c4") <> "" Then
  Cells(m, 3).Interior.ColorIndex = 4
Range("r" & m) = 1
Range("s" & m) = 0
n = n + 1
End If

If Range("j" & m) = Range("d4") And Range("d4") <> "" Then
  Cells(m, 10).Interior.ColorIndex = 4
Range("r" & m) = 1
Range("s" & m) = 0
  n = n + 1
End If

If Range("i" & m) = Range("e4") And Range("e4") <> "" Then
   Cells(m, 9).Interior.ColorIndex = 4
Range("r" & m) = 1
Range("s" & m) = 0
  n = n + 1
End If


If Range("k" & m) = Range("f4") And Range("f4") <> "" Then
  Cells(m, 11).Interior.ColorIndex = 4
Range("r" & m) = 1
Range("s" & m) = 0
  n = n + 1
End If

Next m

Range("G4") = "=sum(R:R)"
Range("j4") = n

Range("A5:s" & Cells(Rows.Count, 1).End(xlDown).Row).Sort key1:=Range("s1"), Order1:=xlAscending, Header:=xlYes
MsgBox "工作表顺序表已发生改变，继续将恢复初始状态!"
Range("A5:s" & Cells(Rows.Count, 1).End(xlDown).Row).Sort key1:=Range("a1"), Order1:=xlAscending, Header:=xlYes
Range("R:s") = ""
Range("A6:Q" & p).Interior.Color = RGB(204, 232, 207)
Range("B4:j4") = ""

End Sub
2、数据保护部分，增加了一行数据，并隐藏。见代码
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next  '出现错误继续
    If Target.Column > 22 Then Exit Sub
    Application.EnableEvents = False
    If Range("Y" & Target.Row) = "数据行" Then
        MsgBox "数据行禁止修改!"
        Application.Undo
    End If
    Application.EnableEvents = True
   
End Sub
3、原有的发票是否开具，收到，由于数据保护问题，改放到go to data里面，编号，日期要同时录入。增加如下代码：
'*******************追加部分，数据修改
x = Cells(Rows.Count, "a").End(xlUp).Row
If x > 1 Then
Range("Y2:Y" & x) = "数据行"
Range("Y1") = "权限"
Columns("Y:Y").Hidden = True
Range("Y:Y").Interior.Color = RGB(204, 232, 207)
Range("Y:Y").Font.Color = RGB(204, 232, 207)
End If
'*******************追加部分，发票相关
For i = 2 To Cells(Rows.Count, "a").End(xlUp).Row
If Cells(i, "j") = "入库单" Then
    Cells(i, "x") = IIf(Len(Cells(i, "t")) > 0 And Len(Cells(i, "u")) > 0, "Y", "N")
    Cells(i, "w").Font.Color = IIf(Cells(i, "x") = "Y", vbRed, vbBlue)
    Cells(i, "w").value = IIf(Cells(i, "x") = "Y", "已", "未") & "收发票"
    Else
     Cells(i, "x") = IIf(Len(Cells(i, "t")) > 0 And Len(Cells(i, "u")) > 0, "Y", "N")
    Cells(i, "w").Font.Color = IIf(Cells(i, "x") = "Y", vbGreen, vbMagenta)
    Cells(i, "w").value = IIf(Cells(i, "x") = "Y", "已", "未") & "开发票"
      End If
     
  Next
'*****************************追加结束
4，其它，为了数据能正常保存，在各保存模块中增加了删除明细表隐藏列代码：在进入明细表时，增加了隐藏列代码。数据引用由原来到P列，扩展到X列，以保证改动部分不发生冲突。
6、所有改动部分都做了*************线标记，原有代码保留，作为注释。
7、登陆窗口删除了原有信息，并可以随意改动。
8、敬请各位老师对改动部分加以指正。
附件如下：

350977106

再请问楼主一个问题，主界面图标都可以指向对应工作表，但宏不可编辑，查看是如何做到的。
图片如下