因此,当前我正在使用此代码从用户表单中提取新输入的数据(或从已删除数据中创建的空白),然后通过复制模板模板中的格式将其添加到活动工作表中工作簿的开始。
我希望有人能以一种更清洁的方式建议我,前提是: 答:模板可能会更改(颜色,文本颜色等) B.范围应始终保持不变(由于交替的配色方案,它们当前处于交替状态) C.如果没有数据,则某些行将为空白,并且所有格式都需要删除,或者将其设置为默认值以使其显示为空白。
我很抱歉,某些代码本质上是重复代码,但我想显示增量的程度。
Private Sub AddFieldsToForm()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim OpCode As String
' Copy the data to the newly created item page, if nothing is entered, remove the text on the page
ws.Cells(5, 3).Value = Me.R_ItemNo & " - " & Me.R_OpCode
If Me.R_PartName = "" Then ' Checks to see if it is left blank, if so it clears the row.
Range("B6:D6").ClearContents
Range("E6").AutoFill Destination:=Range("C6:E6"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy ' If you are updating the form with data restores formatting before inputing data
With Range("C6:D6")
.PasteSpecial xlPasteFormats
End With
Range("C6:D6").Merge (Across)
ws.Cells(6, 3).Value = Me.R_PartName
ws.Cells(6, 2).Value = "PART NAME" ' If you are updating the form with data restores blanked row labels
End If
If Me.R_Press = "" Then
Range("B7:D7").ClearContents
Range("E7").AutoFill Destination:=Range("C7:E7"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C7:D7")
.PasteSpecial xlPasteFormats
End With
Range("C7:D7").Merge (Across)
ws.Cells(7, 3).Value = Me.R_Press
ws.Cells(7, 2).Value = "PRESS"
End If
If Me.R_Tools = "" Then
Range("B8:D8").ClearContents
Range("E8").AutoFill Destination:=Range("C8:E8"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C8:D8")
.PasteSpecial xlPasteFormats
End With
Range("C8:D8").Merge (Across)
ws.Cells(8, 3).Value = Me.R_Tools
ws.Cells(8, 2).Value = "TOOLS"
End If
If Me.R_StartPsi = "" Then
Range("B10:D10").ClearContents
Range("E10").AutoFill Destination:=Range("C10:E10"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C10:D10")
.PasteSpecial xlPasteFormats
End With
Range("C10:D10").Merge (Across)
ws.Cells(10, 3).Value = Me.R_StartPsi
ws.Cells(10, 2).Value = "START PSI"
End If
If Me.R_ReliefPsi = "" Then
Range("B11:D11").ClearContents
Range("E11").AutoFill Destination:=Range("C11:E11"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C11:D11")
.PasteSpecial xlPasteFormats
End With
Range("C11:D11").Merge (Across)
ws.Cells(11, 3).Value = Me.R_ReliefPsi
ws.Cells(11, 2).Value = "RELIEF PSI"
End If
If Me.R_FinalH20Psi = "" Then
Range("B12:D12").ClearContents
Range("E12").AutoFill Destination:=Range("C12:E12"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C12:D12")
.PasteSpecial xlPasteFormats
End With
Range("C12:D12").Merge (Across)
ws.Cells(12, 3).Value = Me.R_FinalH20Psi
ws.Cells(12, 2).Value = "FINAL H20 PSI"
End If
If Me.R_FinalOilPsi = "" Then
Range("B13:D13").ClearContents
Range("E13").AutoFill Destination:=Range("C13:E13"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C13:D13")
.PasteSpecial xlPasteFormats
End With
Range("C13:D13").Merge (Across)
ws.Cells(13, 3).Value = Me.R_FinalOilPsi
ws.Cells(13, 2).Value = "FINAL OIL PSI"
End If
If Me.R_QuillPsi = "" Then
Range("B14:D14").ClearContents
Range("E14").AutoFill Destination:=Range("C14:E14"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C14:D14")
.PasteSpecial xlPasteFormats
End With
Range("C14:D14").Merge (Across)
ws.Cells(14, 3).Value = Me.R_QuillPsi
ws.Cells(14, 2).Value = "QUILL PSI"
End If
If Me.R_QuillReliefPsi = "" Then
Range("B15:D15").ClearContents
Range("E15").AutoFill Destination:=Range("C15:E15"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C15:D15")
.PasteSpecial xlPasteFormats
End With
Range("C15:D15").Merge (Across)
ws.Cells(15, 3).Value = Me.R_QuillReliefPsi
ws.Cells(15, 2).Value = "QUILL RELIEF PSI"
End If
If Me.R_KOPsi = "" Then
Range("B16:D16").ClearContents
Range("E16").AutoFill Destination:=Range("C16:E16"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C16:D16")
.PasteSpecial xlPasteFormats
End With
Range("C16:D16").Merge (Across)
ws.Cells(16, 3).Value = Me.R_KOPsi
ws.Cells(16, 2).Value = "K.O. PSI"
End If
If Me.R_KOReliefPsi = "" Then
Range("B17:D17").ClearContents
Range("E17").AutoFill Destination:=Range("C17:E17"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C17:D17")
.PasteSpecial xlPasteFormats
End With
Range("C17:D17").Merge (Across)
ws.Cells(17, 3).Value = Me.R_KOReliefPsi
ws.Cells(17, 2).Value = "K.O. RELIEF PSI"
End If
If Me.R_DieGap = "" Then
Range("B18:D18").ClearContents
Range("E18").AutoFill Destination:=Range("C18:E18"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C18:D18")
.PasteSpecial xlPasteFormats
End With
Range("C18:D18").Merge (Across)
ws.Cells(18, 3).Value = Me.R_DieGap
ws.Cells(18, 2).Value = "DIE GAP"
End If
If Me.R_Limit = "" Then
Range("B19:D19").ClearContents
Range("E19").AutoFill Destination:=Range("C19:E19"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C19:D19")
.PasteSpecial xlPasteFormats
End With
Range("C19:D19").Merge (Across)
ws.Cells(19, 3).Value = Me.R_Limit
ws.Cells(19, 2).Value = "LIMIT"
End If
If Me.R_ORings = "" Then
Range("B20:D20").ClearContents
Range("E20").AutoFill Destination:=Range("C20:E20"), Type:=xlFillDefault
Else
Sheets("Template").Range("C5:D5").Copy
With Range("C20:D20")
.PasteSpecial xlPasteFormats
End With
Range("C20:D20").Merge (Across)
ws.Cells(20, 3).Value = Me.R_ORings
ws.Cells(20, 2).Value = "O-RINGS"
End If
If Me.R_Lubes = "" Then
Range("B21:D21").ClearContents
Range("E21").AutoFill Destination:=Range("C21:E21"), Type:=xlFillDefault
Else
Sheets("Template").Range("C6:D6").Copy
With Range("C21:D21")
.PasteSpecial xlPasteFormats
End With
Range("C21:D21").Merge (Across)
ws.Cells(21, 3).Value = Me.R_Lubes
ws.Cells(21, 2).Value = "LUBES"
End If
If Me.R_Notes = "" Then
ws.Cells(3, 6).Value = "Notes to be added later"
Else
ws.Cells(3, 6).Value = Me.R_Notes
End If
If Me.R_OpCode = "FORM 1" Then ' Converts the operation into an OpCode to be used elsewhere
OpCode = "F1"
ElseIf Me.R_OpCode = "FORM 2" Then
OpCode = "F2"
ElseIf Me.R_OpCode = "FORM 3" Then
OpCode = "F3"
End If
' Update Sheet Name with new item number.
ws.Name = Me.R_ItemNo & OpCode
End Sub