AW: Datei neu machen: Formeln, bed. Formatierungen
15.10.2024 07:08:57
MCO
Moin, guennih!
Ich hab mir mal was gebaut, bei dem ich je nach Bedarf Zelen ein-/auskommentiere.
auch die Range musst du wahrscheinlich anders definieren, aber damit kommst du sicher klar.
Zum Formeln auslesen
Sub formel()
Dim zähler As Long
Dim rng As Range
Dim cl As Range
Dim frml As String
Dim frml_locl As String
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeFormulas)
'Set rng = Union(rng, Selection.SpecialCells(xlCellTypeConstants))
Dim dat As Variant
txt = "C:\Temp\test.txt"
Open txt For Output As #1
For Each cl In rng
zähler = zähler + 1
frml = cl.FormulaLocal
frml = Replace(frml, """", """""")
frml_locl = IIf(Left(frml, 1) = "=", ".formula2local", "")
' frml = Replace(frml, Chr(10), "") 'Umbrüche entfernen
' Do
' frml = Replace(frml, " ", " ") 'doppelte Leerzeichen entfernen
' Loop While InStr(frml, " ") > 0
Debug.Print ".Range(""" & cl.Address(0, 0) & """)" & frml_locl & " = """ & frml & """"
'Debug.Print ".Range(""" & cl.Address(0, 0) & """).numberformat = """ & cl.NumberFormat&; """"
'Debug.Print cl.Column & "," & cl.Row & "," & ".Range(""" & cl.Address(0, 0) & """).formulalocal = """ & frml & """"
'Debug.Print Split(frml, "+")(1) & Split(frml, "+")(2)
'Schreibt Zellinhalte in eine lokale Textdatei
' If frml > "" Then
' Print #1, ".Range(""" & cl.Address(0, 0) & """)" & frml_locl & " = """ & frml & """"
' End If
Next cl
Close #1
End Sub
Sub bedingte_formatierung_auslesen()
Dim rng As Range
Dim fc
For Each fc In ActiveSheet.Cells.FormatConditions
Set rng = Range(fc.AppliesTo.Areas(1).Address)
On Error Resume Next
With fc
Debug.Print "With Range(""" & fc.AppliesTo.Areas(1).Address & """)"
'Debug.Print ".FormatConditions(activesheet.FormatConditions.Count).SetFirstPriority"
Debug.Print " Set n_FC = .FormatConditions.Add (Type:=xlExpression, Formula1:=""" & Replace(.Formula1, """", """""") & """)"
Debug.Print " with n_FC"
Debug.Print " with .Interior"
If Not (IsNull(.Interior.PatternColorIndex)) Then Debug.Print " .PatternColorIndex = " & .Interior.PatternColorIndex
If Not (IsNull(.Interior.ThemeColor)) Then Debug.Print " .ThemeColor = " & .Interior.ThemeColor
If Not (IsNull(.Interior.TintAndShade)) Then Debug.Print " .TintAndShade = " & .Interior.TintAndShade
Debug.Print " End With" & Chr(13)
Debug.Print " with .font"
If Not (IsNull(.Font.ColorIndex)) Then Debug.Print " .Font.ColorIndex = " & .Font.ColorIndex
If Not (IsNull(.Font.Bold)) Then Debug.Print " .Font.bold = " & .Font.Bold * 1
If Not (IsNull(.Font.TintAndShade)) Then Debug.Print " .Font.TintAndShade = " & .Font.TintAndShade
Debug.Print " End With"
Debug.Print " .StopIfTrue = " & .StopIfTrue; ""
Debug.Print " End With"
Debug.Print "End With" & Chr(13)
Debug.Print "'" & WorksheetFunction.Rept("_", 50) & Chr(13)
End With
Next
End Sub
Bei Namen und Dropdowns hab ich nix
Gruß, MCO