EEC 欧姆龙PLC输入模块算法

   

  • Option Explicit
  • Public MyArray(20000) As Integer
  • Public MyArraySensor(20000) As Integer
  • Sub 生成输入模块信息()
  • Dim SourceTab As String
  • Dim TargetTab As String
  • Dim ProjTab As String
  • Dim StartRow As Integer
  • Dim EndRow As Integer
  • Dim PRow As Integer
  • Dim ModuleRow, SensorRow As Integer
  • Dim Proj As MyType
  • Dim Target As MyType
  • Dim InputModule, ModulePath, SensorPath As String
  • Dim FrameName As String
  • Dim MyTempA, MyTempK, MaxRowD As Integer
  • Dim SensorInt, SensorRem As Integer
  • Dim SensorRowRelative As Integer
  • Dim SensorMacroPosition As String
  • Dim SensorChannelNum As Integer
  • Dim SensorIdentifier As String
  • Dim SensorPage As Integer
  • Dim SensorY As Integer '传感器Y坐标

    Dim TargetMaxRowA As Integer
  • SourceTab = "输入模块参数"
  • ProjTab = "项目IO表"
  • TargetTab = "生成输入模块图纸"
  • 'TargetTab = "表单"

    FrameName = "Fn1_Maider_A3"
  • ModulePath = "OMRON"

    SensorPath = "OtherMacros"
  • StartRow = 2
  • EndRow = 19999
  • MyTempK = 0
  • '*********模块数据填充

    '    模块型号检测

    For Proj.CRowNum = 4 To 11 Step 1
  • If Worksheets(ProjTab).Range("C" & Proj.CRowNum) = 1 Then
  • InputModule = Worksheets(ProjTab).Range("B" & Proj.CRowNum)
  • End If
  • Next
  • 'MsgBox InputModule

    '    求取模糊最大行数

    With Worksheets(ProjTab)
  • For Proj.DRowNum = 4 To 20000 Step 16
  • If .Range("D" & Proj.DRowNum) = "" Then
  • MyTempK = MyTempK + 1
  • Else
  • MyTempK = 0
  • End If
  • If MyTempK >= 500 Then
  • MaxRowD = Proj.DRowNum - 500
  • Exit For
  • End If
  • Next
  • End With
  • ' MsgBox MaxRowD

    '    页Left模块数据填充

    For Proj.DRowNum = 4 To MaxRowD Step 32
  • If Worksheets(ProjTab).Range("D" & Proj.DRowNum) <> "" Then
  • Call Traverse(SourceTab, "A2:A20000", Left(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 5), SensorRowRelative)
  • ModuleRow = Application.WorksheetFunction.Quotient((Proj.DRowNum - 4), 32) * 68 + 2
  • 'PLC模块数据填充

    With Worksheets(TargetTab)
  • .Range("A" & ModuleRow) = "####[x/y]"
  • .Range("A" & ModuleRow + 1) = ModulePath & InputModule
  • .Range("C" & ModuleRow + 1) = Worksheets(SourceTab).Range("B" & SensorRowRelative)
  • .Range("E" & ModuleRow + 1) = Worksheets(SourceTab).Range("C" & SensorRowRelative)
  • .Range("I" & ModuleRow + 1) = Worksheets(SourceTab).Range("D" & SensorRowRelative)
  • .Range("J" & ModuleRow + 1) = "多线 <1>"
  • .Range("K" & ModuleRow + 1) = "A"
  • Select Case Worksheets(SourceTab).Range("E" & SensorRowRelative)
  • Case "Left"
  • '左侧时填充数据

    .Range("M" & ModuleRow + 1) = 0
  • .Range("N" & ModuleRow + 1) = 297
  • If Worksheets(SourceTab).Range("E" & SensorRowRelative + 1) = "Right" Then
  • .Range("Q" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "_" & Worksheets(SourceTab).Range("A" & SensorRowRelative + 1)
  • Else
  • .Range("Q" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative)
  • End If
  • .Range("R" & ModuleRow + 1) = FrameName
  • Case "Right"
  • '右侧侧时填充数据

    .Range("M" & ModuleRow + 1) = 210
  • .Range("N" & ModuleRow + 1) = 297
  • Case Else
  • MsgBox "Macro Position 数据错误，请检查！！！"
  • End Select
  • 'PLC模块填充数据

    .Range("S" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative)
  • .Range("T" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "00"
  • .Range("U" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "01"
  • .Range("V" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "02"
  • .Range("W" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "03"
  • .Range("X" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "04"
  • .Range("Y" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "05"
  • .Range("Z" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "06"
  • .Range("AA" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "07"
  • .Range("AB" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "08"
  • .Range("AC" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "09"
  • .Range("AD" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "10"
  • .Range("AE" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "11"
  • .Range("AF" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "12"
  • .Range("AG" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "13"
  • .Range("AH" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "14"
  • .Range("AI" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "15"
  • End With
  • End If
  • Next
  • '页Right模块数据填充

    For Proj.DRowNum = 20 To MaxRowD Step 32
  • If Worksheets(ProjTab).Range("D" & Proj.DRowNum) <> "" Then
  • Call Traverse(SourceTab, "A2:A20000", Left(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 5), SensorRowRelative)
  • ModuleRow = Application.WorksheetFunction.Quotient((Proj.DRowNum - 4), 32) * 68 + 4
  • 'PLC模块数据填充

    With Worksheets(TargetTab)
  • .Range("A" & ModuleRow) = "####[x/y]"
  • .Range("A" & ModuleRow + 1) = ModulePath & InputModule
  • .Range("C" & ModuleRow + 1) = Worksheets(SourceTab).Range("B" & SensorRowRelative)
  • .Range("E" & ModuleRow + 1) = Worksheets(SourceTab).Range("C" & SensorRowRelative)
  • .Range("I" & ModuleRow + 1) = Worksheets(SourceTab).Range("D" & SensorRowRelative)
  • .Range("J" & ModuleRow + 1) = "多线 <1>"
  • .Range("K" & ModuleRow + 1) = "A"
  • Select Case Worksheets(SourceTab).Range("E" & SensorRowRelative)
  • Case "Left"
  • '左侧时填充数据

    .Range("M" & ModuleRow + 1) = 0
  • .Range("N" & ModuleRow + 1) = 297
  • If Worksheets(SourceTab).Range("E" & SensorRowRelative + 1) = "Right" Then
  • .Range("Q" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "_" & Worksheets(SourceTab).Range("A" & SensorRowRelative + 1)
  • Else
  • .Range("Q" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative)
  • End If
  • .Range("R" & ModuleRow + 1) = FrameName
  • Case "Right"
  • '右侧侧时填充数据

    .Range("M" & ModuleRow + 1) = 210
  • .Range("N" & ModuleRow + 1) = 297
  • Case Else
  • MsgBox "Macro Position 数据错误，请检查！！！"
  • End Select
  • 'PLC模块填充数据

    .Range("S" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative)
  • .Range("T" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "00"
  • .Range("U" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "01"
  • .Range("V" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "02"
  • .Range("W" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "03"
  • .Range("X" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "04"
  • .Range("Y" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "05"
  • .Range("Z" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "06"
  • .Range("AA" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "07"
  • .Range("AB" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "08"
  • .Range("AC" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "09"
  • .Range("AD" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "10"
  • .Range("AE" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "11"
  • .Range("AF" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "12"
  • .Range("AG" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "13"
  • .Range("AH" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "14"
  • .Range("AI" & ModuleRow + 1) = Worksheets(SourceTab).Range("A" & SensorRowRelative) & "15"
  • End With
  • End If
  • Next
  • '*********传感器数据填充
  • ' 项目表中传感器行号 除以32 整数部分 IF(项目表中传感器 <> "",QUOTIENT((项目表中传感器行号-4),32)*68+6,"")

    '     项目表中传感器行号 除以32 余数部分

    Dim TempRem, NearInt As Integer
  • For Proj.DRowNum = 4 To MaxRowD Step 1
  • If Worksheets(ProjTab).Range("D" & Proj.DRowNum) <> "" Then
  • If (Proj.DRowNum - 4) Mod 32 = 0 Then
  • SensorRow = Application.WorksheetFunction.Quotient((Proj.DRowNum - 4), 32) * 68 + 6
  • Else
  • SensorRem = (Proj.DRowNum - 4) Mod 32
  • NearInt = Proj.DRowNum - SensorRem
  • SensorInt = Application.WorksheetFunction.Quotient((NearInt - 4), 32) * 68 + 6
  • SensorRow = SensorInt + SensorRem * 2
  • End If
  • ' MsgBox Proj.DRowNum & "," & SensorRow
  • End If
  • '传感器数据填充区，前两行特例

    If Worksheets(ProjTab).Range("D" & Proj.DRowNum) <> "" Then
  • With Worksheets(TargetTab)
  • If (Proj.DRowNum - 4) Mod 32 = 0 Or (SensorRow - 7) Mod 68 = 1 Then
  • '(Proj.DRowNum - 4) Mod 32 = 0 第一个传感器

    ' (SensorRow - 7) Mod 68     第二个传感器

    .Range("A" & SensorRow) = "####[X]"
  • .Range("A" & SensorRow + 1) = SensorPath & Worksheets(ProjTab).Range("H" & Proj.DRowNum)
  • '区分第一个还是第二个

    If Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then
  • If Int(Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)) = 0 Then '第一个传感器================

    .Range("K" & SensorRow + 1) = "A"
  • ElseIf Int(Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)) = 1 Then '第二个传感器================

    .Range("K" & SensorRow + 1) = "B"
  • End If
  • .Range("M" & SensorRow + 1) = 0
  • .Range("N" & SensorRow + 1) = 0
  • End If
  • Else
  • '其他30个传感器

    If Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then '    项目表中IO有注释部分

    .Range("A" & SensorRow) = "####[O=X/Y]"
  • .Range("A" & SensorRow + 1) = SensorPath & Worksheets(ProjTab).Range("H" & Proj.DRowNum)
  • End If
  • If Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then
  • '判断传感器的奇偶性，奇数宏变量为B，偶数为A

    If Int(Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)) Mod 2 = 0 Then '    偶数

    .Range("K" & SensorRow + 1) = "A"
  • ElseIf Int(Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)) Mod 2 = 1 Then '奇数

    .Range("K" & SensorRow + 1) = "B"
  • End If
  • End If
  • 'X坐标

    '    检测传感器对应在Eplan图纸中的位置，left 或者 right

    Call Traverse(SourceTab, "A2:A20000", Left(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 5), SensorRowRelative)
  • SensorMacroPosition = Worksheets(SourceTab).Range("E" & SensorRowRelative)
  • If Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then '项目表中IO有注释部分

    If SensorMacroPosition = "Left" Then
  • .Range("M" & SensorRow + 1) = 0
  • End If
  • If SensorMacroPosition = "Right" Then
  • .Range("M" & SensorRow + 1) = 210
  • End If
  • End If
  • 'Y坐标

    'Y    坐标数值初始化

    Select Case Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)
  • Case "02"
  • SensorY = 24
  • Case "03"
  • SensorY = 24
  • Case "04"
  • SensorY = 48
  • Case "05"
  • SensorY = 48
  • Case "06"
  • SensorY = 72
  • Case "07"
  • SensorY = 72
  • Case "08"
  • SensorY = 96
  • Case "09"
  • SensorY = 96
  • Case "10"
  • SensorY = 120
  • Case "11"
  • SensorY = 120
  • Case "12"
  • SensorY = 144
  • Case "13"
  • SensorY = 144
  • Case "14"
  • SensorY = 168
  • Case "15"
  • SensorY = 168
  • Case Else
  • SensorY = 0
  • End Select
  • If Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then '项目表中IO有注释部分

    .Range("N" & SensorRow + 1) = SensorY
  • End If
  • End If
  • '传感器相同格式部分================

    'SensorNumber**********

    '    标识符定义

    Select Case Worksheets(ProjTab).Range("H" & Proj.DRowNum)
  • Case "6_磁性开关-常开"
  • SensorIdentifier = "-B"
  • Case ""
  • SensorIdentifier = ""
  • Case Else
  • MsgBox "传感器类型错误，请检查！！！" & ",项目IO表行号为：" & Proj.DRowNum
  • End Select
  • '检测传感器对应在Eplan图纸中页码

    Call Traverse(SourceTab, "A2:A20000", Left(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 5), SensorRowRelative)
  • SensorPage = Int(Worksheets(SourceTab).Range("D" & SensorRowRelative))
  • SensorMacroPosition = Worksheets(SourceTab).Range("E" & SensorRowRelative)
  • If SensorMacroPosition = "Left" And Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then
  • .Range("O" & SensorRow + 1) = SensorIdentifier & SensorPage & Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)
  • ElseIf SensorMacroPosition = "Right" And Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then
  • .Range("O" & SensorRow + 1) = SensorIdentifier & SensorPage & (Int(Right(Worksheets(ProjTab).Range("D" & Proj.DRowNum), 2)) + 16)
  • ElseIf SensorMacroPosition <> "Left" And SensorMacroPosition <> "Right" Then
  • MsgBox "Macro Position 数据错误，请检查！！！"
  • End If
  • .Range("P" & SensorRow + 1) = Worksheets(ProjTab).Range("E" & Proj.DRowNum) & Worksheets(ProjTab).Range("F" & Proj.DRowNum)
  • If Worksheets(ProjTab).Range("F" & Proj.DRowNum) <> "" Then '项目表中IO有注释部分

    .Range("J" & SensorRow + 1) = "    多线 <1>"
  • End If
  • End With
  • End If
  • Next
  • '注释命令部分
  • With Worksheets(TargetTab)
  • For Target.ARowNum = 2 To 20000 Step 1
  • If .Range("A" & Target.ARowNum) = "" Then
  • MyTempA = MyTempA + 1
  • Else
  • MyTempA = 0
  • End If
  • If MyTempA >= 500 Then
  • TargetMaxRowA = Target.ARowNum - 500
  • Exit For
  • End If
  • Next
  • For Target.ARowNum = 2 To TargetMaxRowA Step 1
  • If Worksheets(TargetTab).Range("A" & Target.ARowNum) = "" Then
  • Worksheets(TargetTab).Range("L" & Target.ARowNum) = "!"
  • End If
  • Next
  • End With
  • MsgBox "数据生成完成！"
  • End Sub
【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/isunlitao/p/6552937.html