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