打印单元格的值加上相应的单元格两行

时间:2014-02-19 15:43:18

标签: excel vba excel-vba

问题:有没有办法让excel识别最近修改过的单元格或查看A列,只打印到最后输入的数据,而不是像400页那样打印,因为我的公式转到D列的第999行。

我目前有一个工作簿,我的团队将数据放入A列,然后宏使用数据从两个来源获取信息,然后在D列中执行公式。我构建的打印函数询问队友多少行他们放入的数据然后使用打印选择选项来选择行加上标题和打印。 (它也把今天的日期列在E栏中,但是我把它隐藏起来是白色字体,打印时会变成黑色)。

以下是我目前的代码感谢任何帮助调整它

Private Sub PrintArea()
Dim Row As Long
On Error GoTo 1

Row = Application.InputBox("How Many Rows")

Worksheets("Data").Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(Row + 1, 5)).Select

ActiveSheet.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Worksheets("Data").Range("E1").Font.Color = vbWhite
Range(Cells(2, 1), Cells(250, 3)).ClearContents


1:  Exit Sub

End Sub

3 个答案:

答案 0 :(得分:1)

您可以使用.End(xlDown)获取任何列的最后一个空单元格。这将为您提供更准确的范围。这是您的代码的略微修改版本。

Private Sub PrintArea()

On Error GoTo 1

Dim i As Integer, k As Integer, j As Integer 'I add these usable integer variables for everything.
Dim Report As Worksheet, bReport As Workbook 'Create a worksheet and workbook variable...once again I add these to everything (just in case I need them later).

Set Report = Excel.ActiveSheet 'Set the report variable to your active worksheet.

k = Report.Cells(1, 1).EntireColumn.End(xlDown) 'SEE EDIT AT BOTTOM 'Here we get the last cell in the first column that has a value. You can change this to another column if need be.


Worksheets("Data").Range("E1").Font.Color = vbBlack
Report.Range(Cells(1, 1), Cells(r + 1, 5)).Select

Report.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Worksheets("Data").Range("E1").Font.Color = vbWhite
Range(Cells(2, 1), Cells(250, 3)).ClearContents


1:  Exit Sub

End Sub

修改

在我花了一分钟来审核代码之后,看起来我在上面的例子中误用了.End(xlDown)。而是使用以下内容来拉取包含值的该列的最后一个单元格:

k = Report.Cells(Report.UsedRange.Rows.Count + 1, 1).End(xlUp).Row

答案 1 :(得分:0)

您可以添加一个worksheet_change事件处理程序。每当用户进行一些更改时,宏都可以记录在另一张表中所做的更改以供以后使用:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' or check for any other range
    If Target.Address = Range("A1").Address Then
        'your code
    End If 
End Sub

答案 2 :(得分:0)

Lopsided让我非常接近我没有代表给他+1或我会,但这里是我找到的对我有用的答案。

我改变的是

Dim R as Integer

R = Range("A65536").End(xlUp).Row

ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select 

这使得选择准确并解决了问题。

再次感谢Lopsided

以下是完整代码

Private Sub PrintArea()
Dim R As Integer
On Error GoTo 1

R = Range("A65536").End(xlUp).Row

Worksheets("Data").Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select

ActiveSheet.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Worksheets("Data").Range("E1").Font.Color = vbWhite
Range(Cells(2, 1), Cells(250, 3)).ClearContents


1:  Exit Sub

End Sub