form_gdword.frm

业余做的水利工程压力管道质检表自生成软件！

        xc(0, 1) = 1
        xc(0, 2) = 1
        xc(1, 2) = Scz(xc(0, 0), yxpc, xc(0, 1), 8, 10, tbs)
        '2、△始装节管口中心
        yxpc = 4 '允许偏差
        xc(1, 0) = 1
        xc(1, 1) = 2
        xc(1, 2) = Scz(xc(1, 0), yxpc, xc(1, 1), 9, 10, tbs)
    Else
        xc(0, 0) = 33
        tabx.Cell(8, 10).Range.Text = "/"
        xc(1, 0) = 33
        tabx.Cell(9, 10).Range.Text = "/"
    End If
    
    '3、与蜗壳、蝴蝶阀、球阀、岔管连接的管节及弯管起点的管口中心
    If Chk_SCW.Value Then
        tmp = Val(Text_LJ.Text)
        If tmp < 3 Or tmp = 3 Then
            yxpc = 6 '允许偏差
        ElseIf tmp > 5 Then
            yxpc = 12 '允许偏差
        Else
            yxpc = 10 '允许偏差
        End If
        xc(2, 0) = 2
        xc(2, 1) = 2
        xc(2, 2) = Scz(xc(2, 0), yxpc, xc(2, 1), 10, 10, tbs)
    Else
        xc(2, 0) = 33
        tabx.Cell(10, 10).Range.Text = "/"
    End If
    
    '4、其它部位管节的管口中心
    yxpc = 10 '允许偏差
    xc(3, 0) = 2
    xc(3, 1) = zfs
    xc(3, 2) = Scz(xc(3, 0), yxpc, xc(3, 1), 12, 10, tbs)
    
    '5、鞍式支座顶面弧度和样板间隙；滚动支座或摇摆支座的支墩垫板高程和纵、横中心
    If Opt_AZ.Value Then
        yxpc = 2 '允许偏差
        xc(4, 0) = 2
        xc(4, 1) = 2
        xc(4, 2) = Scz(xc(4, 0), yxpc, xc(4, 1), 13, 6, tbs)
    ElseIf Opt_GYZ.Value Then
        yxpc = 4 '允许偏差
        xc(4, 0) = 2
        xc(4, 1) = 3
        xc(4, 2) = 3
        tmp = Int(yxpc * Rnd * 10) / 10: If tmp < 1 Then temp = "0" + Trim(Str$(tmp)) Else temp = Str$(tmp)
        tabx.Cell(14, 6).Range.Text = "高程+" + temp
        tmp = Int(yxpc * Rnd * 10) / 10: If tmp < 1 Then temp = "0" + Trim(Str$(tmp)) Else temp = Str$(tmp)
        tabx.Cell(15, 6).Range.Text = "纵中心+" + temp
        tmp = Int(yxpc * Rnd * 10) / 10: If tmp < 1 Then temp = "0" + Trim(Str$(tmp)) Else temp = Str$(tmp)
        tabx.Cell(15, 6).Range.InsertAfter ",横中心+" + temp
        tabx.Cell(13, 7).Range.Text = xc(4, 2): tabx.Cell(13, 8).Range.Text = 100
    Else
        xc(4, 0) = 33
        tabx.Cell(13, 6).Range.Text = "/"
        tabx.Cell(14, 6).Range.Text = "/"
    End If
    
    '6、与钢管设计轴线的平行度
    yxpc = 2 '允许偏差
    xc(5, 0) = 2
    xc(5, 1) = zfs
    xc(5, 2) = Scz(xc(5, 0), yxpc, xc(5, 1), 16, 6, tbs)
    
    '7、各接触面的局部间隙(滚动支座和摇摆支座)
    If Opt_GYZ.Value Then
        yxpc = 2 '允许偏差
        xc(6, 0) = 2
        xc(6, 1) = zfs
        xc(6, 2) = Scz(xc(6, 0), yxpc, xc(6, 1), 17, 6, tbs)
    Else
        xc(6, 0) = 33
        tabx.Cell(17, 6).Range.Text = "/"
    End If
     
    For tp = 0 To UBound(xc, 1)
        If xc(tp, 0) = 1 Then zxm = zxm + 1: zds = zds + xc(tp, 1): zhgds = zhgds + xc(tp, 2)
        If xc(tp, 0) = 11 Then zxm = zxm + 1
        If xc(tp, 0) = 2 Then
            yxm = yxm + 1
            yds = yds + xc(tp, 1): yhgds = yhgds + xc(tp, 2)
            If yhgds / yds < 0.9 Then yxmy = yxmy + 1
        End If
        If xc(tp, 0) = 22 Then yxm = yxm + 1
        'xc(tp, 0) = 33 本项不选
    Next tp
    zxmy = zxm
    yxmy = yxm - yxmy

    xcxm(tbs - 2, 0) = zxm: xcxm(tbs - 2, 1) = zxmy: xcxm(tbs - 2, 2) = zds: xcxm(tbs - 2, 3) = zhgds
    xcxm(tbs - 2, 4) = yxm: xcxm(tbs - 2, 5) = yxmy: xcxm(tbs - 2, 6) = yds: xcxm(tbs - 2, 7) = yhgds
    
    '检查结果
    If zxm = 0 Then
        JCJG Val(tbs), 12, 14, "/" '表，下移，右移，文本
        Selection.MoveRight Unit:=wdCharacter, Count:=15
        Selection.TypeText Text:="/"
        Selection.MoveRight Unit:=wdCharacter, Count:=15
        Selection.TypeText Text:="/"
    Else
        JCJG Val(tbs), 12, 14, Str$(xcxm(tbs - 2, 2)) '表，下移，右移，文本
        Selection.MoveRight Unit:=wdCharacter, Count:=15
        Selection.TypeText Text:=xcxm(tbs - 2, 3)
        Selection.MoveRight Unit:=wdCharacter, Count:=15
        Selection.TypeText Text:=Int(xcxm(tbs - 2, 3) / xcxm(tbs - 2, 2) * 100 + 0.5)
    End If
    JCJG Val(tbs), 12, 71, Str$(xcxm(tbs - 2, 6)) '表，下移，右移，文本
    Selection.MoveRight Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=xcxm(tbs - 2, 7)
    Selection.MoveRight Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=Int(xcxm(tbs - 2, 7) / xcxm(tbs - 2, 6) * 100 + 0.5)
    '评定意见
    If zxm = 0 Then
        JCJG Val(tbs), 14, 4, "/"
        Selection.MoveRight Unit:=wdCharacter, Count:=14
        Selection.TypeText Text:="/"
    Else
        JCJG Val(tbs), 14, 4, Str$(xcxm(tbs - 2, 0))
        Selection.MoveRight Unit:=wdCharacter, Count:=14
        Selection.TypeText Text:=Str$(xcxm(tbs - 2, 1))
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=10
    Selection.TypeText Text:=Str$(xcxm(tbs - 2, 4))
    Selection.MoveRight Unit:=wdCharacter, Count:=12
    Selection.TypeText Text:=Str$(xcxm(tbs - 2, 5))
    
End Sub

Public Sub TB2_52(tbs)
    ReDim xc(15, 2) '1-主要项目 2－一般项目
    Set tabx = wD.ActiveDocument.Tables(tbs)

    TBbt tbs '标题栏
    
    '项目
    '1、明管内、外壁防腐蚀表面处理
    xc(0, 0) = 22
    tabx.Cell(6, 5).Range.Text = "喷吵除锈达到Sa2 1/2标准,表面粗糙度50～70μm"
    
    '2、明管内、外壁涂料涂装
    xc(1, 0) = 22
    tabx.Cell(7, 5).Range.Text = "漆膜厚度,外表质量达设计要求,涂层粘附力较强"
         
    For tp = 0 To UBound(xc, 1)
        If xc(tp, 0) = 1 Then zxm = zxm + 1: zds = zds + xc(tp, 1): zhgds = zhgds + xc(tp, 2)
        If xc(tp, 0) = 11 Then zxm = zxm + 1
        If xc(tp, 0) = 2 Then yxm = yxm + 1: yds = yds + xc(tp, 1): yhgds = yhgds + xc(tp, 2)
        If xc(tp, 0) = 22 Then yxm = yxm + 1
        'xc(tp, 0) = 33 本项不选
    Next tp
    zxmy = zxm
    yxmy = yxm

    xcxm(tbs - 2, 0) = zxm: xcxm(tbs - 2, 1) = zxmy: xcxm(tbs - 2, 2) = zds: xcxm(tbs - 2, 3) = zhgds
    xcxm(tbs - 2, 4) = yxm: xcxm(tbs - 2, 5) = yxmy: xcxm(tbs - 2, 6) = yds: xcxm(tbs - 2, 7) = yhgds
         
    '检查结果
    JCJG Val(tbs), 7, 15, Str$(xcxm(tbs - 2, 4)) '表，下移，右移，文本
    Selection.MoveRight Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=xcxm(tbs - 2, 5)
    Selection.MoveRight Unit:=wdCharacter, Count:=16
    Selection.TypeText Text:="/"
    '评定意见
    JCJG Val(tbs), 9, 4, Str$(xcxm(tbs - 2, 4))
    Selection.MoveRight Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=Str$(xcxm(tbs - 2, 5))
    
End Sub

Public Sub TB2_1(tbs)
    ReDim xc(15, 2) '1-主要项目 2－一般项目
    Set tabx = wD.ActiveDocument.Tables(tbs)
    
    TBbt tbs '标题栏
    
    '项目
    '1、瓦片与样板极限间隙
    If Val(Text_LJ.Text) < 2 Or Val(Text_LJ.Text) = 2 Then
        yxpc = 1      '允许偏差
    ElseIf Val(Text_LJ.Text) > 6 Then
        yxpc = 2      '允许偏差
    Else
        yxpc = 1.5      '允许偏差
    End If
    xc(0, 0) = 2
    xc(0, 1) = zfs
    xc(0, 2) = Scz(xc(0, 0), yxpc, xc(0, 1), 8, 10, tbs)
    
    '2、△实际周长与设计周长差
    yxpc = 2.5 * Val(Text_LJ.Text) '允许偏差
    xc(1, 0) = 1
    xc(1, 1) = zfs
    xc(1, 2) = Scz(xc(1, 0), yxpc, xc(1, 1), 9, 6, tbs)

    '3、△相邻管节周长差
    If Val(Text_HD.Text) < 10 Then yxpc = 6 Else yxpc = 8 '允许偏差
    xc(2, 0) = 1
    xc(2, 1) = hfs
    xc(2, 2) = Scz(xc(2, 0), yxpc, xc(2, 1), 10, 6, tbs)

    '4、纵缝、环缝对口错位
    yxpc = 1 '允许偏差
    xc(3, 0) = 2
    xc(3, 1) = zfs * 4
    xc(3, 2) = Scz(xc(3, 0), yxpc, xc(3, 1), 11, 6, tbs)

    '5、△钢管管口平面度
    If Val(Text_LJ.Text) < 5 Or Val(Text_LJ.Text) = 5 Then yxpc = 1.5 Else yxpc = 2 '允许偏差
    xc(4, 0) = 1
    xc(4, 1) = zfs
    xc(4, 2) = Scz(xc(4, 0), yxpc, xc(4, 1), 12, 8, tbs)

    '6、焊缝外观检查
    tabx.Cell(14, 6).Range.Text = "质量优良(见附表)"
    xc(5, 0) = 22
    
    '7、△一、二类焊缝内部焊接质量
    tabx.Cell(15, 6).Range.Text = "质量优良(见附表)"
    xc(6, 0) = 11
    
    '8、纵缝焊后变形△h
    If Val(Text_LJ.Text) < 2 Or Val(Text_LJ.Text) = 2 Then
        yxpc = 2      '允许偏差
    ElseIf Val(Text_LJ.Text) > 6 Then
        yxpc = 4      '允许偏差
    Else
        yxpc = 3      '允许偏差
    End If
    xc(7, 0) = 2
    xc(7, 1) = zfs
    xc(7, 2) = Scz(xc(7, 0), yxpc, xc(7, 1), 16, 10, tbs)

    '9、钢管圆度
    yxpc = 2.5 * Val(Text_LJ.Text) '允许偏差
    xc(8, 0) = 2
    xc(8, 1) = zfs
    xc(8, 2) = Scz(xc(8, 0), yxpc, xc(8, 1), 17, 6, tbs)
    
    '10.1、支承环或加劲环与管壁的铅垂度
    If Txt_H.Enabled Then
        If Opt_ZC.Value Then
            yxpc = 0.01 * Txt_H
            If yxpc > 3 Then yxpc = 3
        Else
            yxpc = 0.02 * Txt_H
            If yxpc > 5 Then yxpc = 5
        End If
        xc(9, 0) = 2
        xc(9, 1) = zfs
        xc(9, 2) = Scz(xc(9, 0), yxpc, xc(9, 1), 18, 6, tbs)
    Else
        tabx.Cell(18, 6).Range.Text = "/"
        xc(9, 0) = 33
    End If
    '10.2、支承环或加劲环所组成的平面现管轴线的铅垂度
    If Txt_H.Enabled Then
        If Opt_ZC.Value Then
            yxpc = 2 * Text_LJ
            If yxpc > 6 Then yxpc = 6
        Else
            yxpc = 4 * Text_LJ
            If yxpc > 12 Then yxpc = 12
        End If
        xc(10, 0) = 2
        xc(10, 1) = zfs
        xc(10, 2) = Scz(xc(10, 0), yxpc, xc(10, 1), 20, 6, tbs)
    Else
        tabx.Cell(20, 6).Range.Text = "/"
        xc(10, 0) = 33
    End If
     
    '续表
    tbs = tbs + 1
    Set tabx = wD.ActiveDocument.Tables(tbs)
    '10.3、相邻两环的间距
     If Txt_H.Enabled Then
        If Opt_ZC.Value Then yxpc = 10 Else yxpc = 30
        xc(11, 0) = 2
        xc(11, 1) = zfs
        xc(11, 2) = Scz(xc(11, 0), yxpc, xc(11, 1), 4, 6, tbs)
    Else
        tabx.Cell(4, 6).Range.Text = "/"
        xc(11, 0) = 33
    End If
    
    '11.1、钢管内、外壁的表面清除
    tabx.Cell(6, 6).Range.Text = "清除干净并磨光"
    xc(12, 0) = 22
    
    '11.2、钢管内、外壁局部凹坑焊补
    yxpc = Int(2 * Rnd * 10) / 10
    If yxpc < 1 Then temp = "0" + Trim(Str$(yxpc)) Else temp = Str$(yxpc)
    tabx.Cell(7, 6).Range.Text = "凹坑补焊并磨光凹坑最大深度为" + temp + "mm"
    xc(13, 0) = 22
    
    '12、埋管和明管防腐蚀表面处理
    xc(14, 0) = 2
    xc(14, 1) = 10
    xc(14, 2) = 10
    tabx.Cell(8, 6).Range.Text = "除锈等级达到Sa2 1/2标准,抽查10点,粗糙度40～70μm;涂装厚度、表面质量及粘附力均符合质量标准"
    tabx.Cell(8, 7).Range.Text = "10"
    tabx.Cell(8, 8).Range.Text = "100"
    '13、埋管和明管防腐蚀涂料涂装
    xc(15, 0) = 22
    tabx.Cell(9, 6).Range.Text = "符合设计要求,外观良好"

    For tp = 0 To UBound(xc, 1)
        If xc(tp, 0) = 1 Then zxm = zxm + 1: zds = zds + xc(tp, 1): zhgds = zhgds + xc(tp, 2)
        If xc(tp, 0) = 11 Then zxm = zxm + 1
        If xc(tp, 0) = 2 Then
            yxm = yxm + 1
            yds = yds + xc(tp, 1): yhgds = yhgds + xc(tp, 2)
            If yhgds / yds < 0.9 Then yxmy = yxmy + 1
        End If
        If xc(tp, 0) = 22 Then yxm = yxm + 1
        'xc(tp, 0) = 33 本项不选
    Next tp
    zxmy = zxm
    yxmy = yxm - yxmy
    
    '检查结果
    JCJG Val(tbs), 7, 12, Str$(zds) '表，下移，右移，文本
    Selection.MoveRight Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=zhgds
    Selection.MoveRight Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=Int(zhgds / zds * 100 + 0.5)
    
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=5
    Selection.TypeText Text:=Int(yhgds / yds * 100 + 0.5)
    Selection.MoveLeft Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=yhgds
    Selection.MoveLeft Unit:=wdCharacter, Count:=15
    Selection.TypeText Text:=yds
    '评定意见
    JCJG Val(tbs), 10, -6, Str$(Int(yhgds / yds * 100 + 0.5))
    Selection.MoveRight Unit:=wdCharacter, Count:=16
    Selection.TypeText Text:=Str$(Int((yhgds + zhgds) / (yds + zds) * 100 + 0.5))
    Selection.MoveRight Unit:=wdCharacter, Count:=16
    Selection.TypeText Text:=Str$(Int(zhgds / zds * 100 + 0.5))
 
End Sub

Public Sub JCJG(TB As Integer, MD As Integer, MR As Integer, TTxt As String) '表，下移，右移，文本
    '检查结果
    Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=TB
    Selection.MoveDown Unit:=wdLine, Count:=MD
    Selection.MoveRight Unit:=wdCharacter, Count:=MR
    Selection.TypeText Text:=TTxt

End Sub

Public Sub JBCS()
    zfs = Text_CDL.Text / Text_CDB.Text '纵缝数量
    hfs = zfs - 1 '环缝数量
    dyzl = Int((Val(Text_CDL.Text) * (Val(Text_LJ.Text) + Val(Text_HD.Text) / 1000) * 3.14 * Val(Text_HD.Text) * 7.85 + 0.5)) / 1000 '单元工程量
        
End Sub

Public Sub TB()
    TBbt 1 '标题栏
    
    For tp = 0 To UBound(xcxm, 1)
        zxm = zxm + xcxm(tp, 0): zxmy = zxmy + xcxm(tp, 1): zds = zds + xcxm(tp, 2): zhgds = zhgds + xcxm(tp, 3)
        yxm = yxm + xcxm(tp, 4): yxmy = yxmy + xcxm(tp, 5): yds = yds + xcxm(tp, 6): yhgds = yhgds + xcxm(tp, 7)
        
        If xcxm(tp, 0) = 0 Then tabx.Cell(6 + tp, 3).Range.Text = "/" Else tabx.Cell(6 + tp, 3).Range.Text = xcxm(tp, 0)
        If xcxm(tp, 1) = 0 Then tabx.Cell(6 + tp, 4).Range.Text = "/" Else tabx.Cell(6 + tp, 4).Range.Text = xcxm(tp, 1)
        If xcxm(tp, 4) = 0 Then tabx.Cell(6 + tp, 5).Range.Text = "/" Else tabx.Cell(6 + tp, 5).Range.Text = xcxm(tp, 4)
        If xcxm(tp, 5) = 0 Then tabx.Cell(6 + tp, 6).Range.Text = "/" Else tabx.Cell(6 + tp, 6).Range.Text = xcxm(tp, 5)
    Next tp
    '合计
    tabx.Cell(6 + tp, 2).Range.Text = zxm
    tabx.Cell(6 + tp, 3).Range.Text = zxmy
    tabx.Cell(6 + tp, 4).Range.Text = yxm
    tabx.Cell(6 + tp, 5).Range.Text = yxmy
    '优良项目占全部顶目的百分数
    tabx.Cell(7 + tp, 2).Range.Text = Int(((zxmy + yxmy) / (zxm + yxm) * 1000 + 0.5)) / 10
    
End Sub

Public Sub TBbt(tbs)
    Set tabx = wD.ActiveDocument.Tables(tbs)
    zxm = 0: zxmy = 0: zds = 0: zhgds = 0 '主要项目个数、共测点数、合格点数
    yxm = 0: yxmy = 0: yds = 0: yhgds = 0 '一般项目个数、共测点数、合格点数
    '标题栏
    tabx.Cell(1, 2).Range.Text = Text_DW.Text: tabx.Cell(1, 4).Range.Text = Str$(dyzl) + "t(D=" + Text_LJ.Text + "m,δ=" + Text_HD.Text + "mm)"
    tabx.Cell(2, 2).Range.Text = Text_FB.Text: tabx.Cell(2, 4).Range.Text = Text_SGDW.Text
    tabx.Cell(3, 2).Range.Text = dyds:         tabx.Cell(3, 4).Range.Text = Text_RQ.Text
End Sub

Private Sub Opt_JJ_Click()
    Txt_H.Enabled = True
End Sub

Private Sub Opt_ZC_Click()
    Txt_H.Enabled = True
End Sub