利用草料二维码进行多部门联合执法数据收集,结合VBA输出规定样式的报表,并实现数据管理

137*****1442023年8月14日4644

        生成或者是制作二维码的网站有很多,如彩虹,微微等但像草料支持数据API功能的网站没有之一,只有唯一。下面我介绍一下二维码在安全生产检查当中的应用。

        安全检查本身不是目的,让企业重视安全生产,最大限度的防止可预知的可管可控的安全生产事故才是目的。

         一般常规安全检查,特别是多部门联查的,大多数情况下检查表有样式要求,且要求多方在检查单上都现场签字并盖章。这时草料二维码恰好可以让这种检查工作变得更加方便,更加规范且更加严谨。下面举一个实例供大家举一反三。

        如果检查表的规定样式如下图:

        建议大家这样安排草料的数据收集方式,新建“安全生产”二维码,然后再里面填加两个操作项,一个被检企业基本信息表单(注意),一个专门用来让其他部门检查人员及企业负责人或安全管理员签字的表单,表单的名字嘛,您随意。

第一个表单如下:

        如果我们前期已经有了一个企业信息数据库,则上面左起第一张图片中除了企业的统一信用代码,其他项都不需要设计到表单中,减少现场录入的时间,为企业,为自己节约更多的时间。


        第二个表单如下

         我们可以插入一个单选组件用以确定签字者的身份,如企业、XX部门;插入一个多选组件用以填写签字所对应的企业列表,如果其中填写A、B、C三个企业名字,则代表签字者对A、B、C三个企业检查结果的确认。


         本地Excel工作簿中有两个工作表,一个和草料联动对接的”企业”检查数据表,如下图:


        还有一个根据“企业”工作表中的数据生成规定样式表的“督导”检查表,样式如本文最开始处的第一张图即是。


VBA代码部分

在“企业”工作表中代码如下:用以实现鼠标单击A1单元格(上图做红色标记的单元格)时自动从后台下载指定信息到工作表。

Private Sub Worksheet_Selecti"color: rgb(0, 102, 204);">        On Error Resume Next

        If Target.Address = "$A$1" Then

                database.ReadCliDatabase

        End If

End Sub


在“督导”工作表中代码如下:用以实现数据切换显示的功能


Private Sub Worksheet_Selecti"color: rgb(0, 102, 204);">        If Target.Column = 11 And Target.Count = 1 Then

                 Select Case Target.Row

                 Case Is = 1

                 PicPro.MyPrint

                 Case Is = 2

                 If [k3] > 1 Then

                         myCls

                         [k3] = [k3] - 1

                 End If

                 [ k3].Select

                Case Is = 4

                If [k3] < Sheet1.Range("b1").End(xlDown).Row - 1 Then

                         myCls

                         [k3] = [k3] + 1

               End If

               [k3].Select

               End Select

               PicPro.属地电话

       End If

End Sub


Sub myCls()

          Dim n As Integer

          With Sheet3

             n = .Shapes.Count

          If n > 0 Then

           Do

                .Shapes(n).Delete

                 n = n - 1


           Loop Until n = 0

           End If

           .[i10:i12].Delete

            End With

End Sub


Sub MyPrint()

           Sheet3.Range("b3").Copy

            Application.EnableEvents = False

          On Error Resume Next

           ActiveWindow.SelectedSheets.PrintOut FROM:=1, To:=2147483647, Copies:=1, Preview:=False, ActivePrinter:="TinyPDF", PrintToFile:=False, Collate:=                     True, IgnorePrintAreas:=False

            Application.EnableEvents = True

End Sub


其他代码字数限制写不下了。

最后给一个demo。有兴趣的看demo吧。





2 个回复
158*****1002023年8月15日
哇,好强呀,收藏学习一下