Question

我正在创建一个基于卡的数据库系统，我想使用一个按钮来基本上能够更新卡，如here所示。

我已经创建了一个按钮并为其分配了一个宏，当单击该按钮时，将添加一行新的“卡片”。但是，我需要我的宏是动态的，以便新卡总是比上一行卡添加3行。该怎么办？

这是我的宏代码：

 Range("B66:F75").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
End With
Range("B66:F75").Select
Range("F75").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B66").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Name:"
Range("B67").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Email:"
Range("B68").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Institution:"
Range("B70").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Research Focus:"
Range("B73").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Expertise:"
Range("B75").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Relevant Links:"
Range("B66:F75").Select
Selection.Copy
Range("H66").Select
ActiveSheet.Paste
Range("N66").Select
ActiveSheet.Paste
Range("W68").Select

我认为需要更改的是范围，以使其动态。

Answer 1

OP在注释中提到它可以从空白纸开始。所以这是我的解决方案。

我假设整个电子表格都填充有中等蓝色，因此代码不会添加该颜色。

Option Explicit

Sub CreatingCards()

'Basic idea is that we will create a base row and then copy paste it "x" times.

Dim TotalRows As Long 'How many rows of cards to generate

Dim lRow As Long 'Used to keep track of the last row of text
Dim p As Long 'Used for looping

TotalRows = 4

With ActiveSheet.Range("B6:F15")
    .Interior.ThemeColor = xlThemeColorAccent5
    .Interior.TintAndShade = 0.799981688894314
    .BorderAround Weight:=xlThin
End With

'Add Words
ActiveSheet.Range("B6").Value = "Name:"
ActiveSheet.Range("B7").Value = "Email:"
ActiveSheet.Range("B8").Value = "Institution:"
ActiveSheet.Range("B10").Value = "Research Focus:"
ActiveSheet.Range("B13").Value = "Expertise:"
ActiveSheet.Range("B15").Value = "Releveant Links:"

'Bold Headers
ActiveSheet.Range("B6").Font.Bold = True
ActiveSheet.Range("B7").Font.Bold = True
ActiveSheet.Range("B8").Font.Bold = True
ActiveSheet.Range("B10").Font.Bold = True
ActiveSheet.Range("B13").Font.Bold = True
ActiveSheet.Range("B15").Font.Bold = True

'Generate the other two cards in the row
ActiveSheet.Range("B6:F15").Copy
ActiveSheet.Range("H6").PasteSpecial xlPasteAll
ActiveSheet.Range("N6").PasteSpecial xlPasteAll

For p = 1 To TotalRows - 1 'Because we generated the first row of cards already

lRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Defines lRow as the last row with text in it.

Range("B6:R15").Copy
Range("B" & lRow + 3).PasteSpecial xlPasteAll  'Putting +3 allows for two blank rows between each card.

Next p


End Sub

如何创建一个在电子表格上添加新“卡片”的按钮？

1 个答案: