AW: Tabellen mit Formeln drucken
15.12.2009 20:45:06
Tino
Hallo,
hier mal ein Anfang zum ausbauen.
Sub Auflistung()
Dim meAr()
Dim rngRange As Range
Dim A&
Dim NeueTab As Worksheet
'Hier die Tabelle angeben
On Error Resume Next
Set rngRange = Sheets("Tabelle1").Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If rngRange Is Nothing Then
MsgBox "keine Formel auf der Tabelle gefunden!"
Exit Sub
End If
Redim Preserve meAr(1 To rngRange.Cells.Count + 1, 1 To 2)
meAr(1, 1) = "Adresse"
meAr(1, 2) = "Formel"
A = 1
For Each rngRange In rngRange
A = A + 1
meAr(A, 1) = rngRange.Parent.Name & "!" & rngRange.Address(0, 0)
If rngRange.HasArray Then
meAr(A, 2) = "'{" & rngRange.FormulaLocal & "}"
Else
meAr(A, 2) = "'" & rngRange.FormulaLocal
End If
Next rngRange
With Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
With .PageSetup
.Orientation = xlLandscape
.Zoom = 80
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
End With
.Cells(1, 1).Resize(Ubound(meAr), 2) = meAr
.Rows(1).Font.Bold = True
.Range("A:B").EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
End With
End Sub
Gruß Tino