title image


Smiley Anzahl benutzerdef. Zellformate (letztes Update)
Hi,



das sollte jetzt der finale Code zum Zählen der benutzerdef. Zellformate sein:



Sub bZellformateZählen()

Dim gefunden As Boolean

Dim i As Long, n As Long, m As Long, lZähler As Integer, t As Long, z As Long

Dim tmpStr As String

Dim tmpFormate()

lZähler = -1

For i = 1 To Worksheets.Count

    For n = 1 To Worksheets(i).UsedRange.Rows.Count

        For m = 1 To Worksheets(i).UsedRange.Columns.Count

            With Worksheets(i).Cells(n, m)

                gefunden = False

                For z = 1 To .Borders.Count

                    If IsNull(.Borders(z).LineStyle) = True Then

                        tmpStr = tmpStr & "000"

                    Else

                        With .Borders(z)

                            tmpStr = tmpStr & IIf(IsNull(.ColorIndex), "0", .ColorIndex) & _

                                        IIf(IsNull(.LineStyle), "0", .LineStyle) & _

                                        IIf(IsNull(.Weight), "0", .Weight)

                        End With

                    End If

                Next

                tmpStr = tmpStr & .Interior.ColorIndex & _

                        .Interior.Pattern & _

                        .Interior.PatternColorIndex & _

                        .NumberFormat & _

                        .Font.ColorIndex & _

                        .Font.Bold & _

                        .Font.Italic & _

                        .Font.Underline & _

                        .Font.FontStyle & _

                        .Font.Background & _

                        .Font.Name & _

                        .Font.OutlineFont & _

                        .Font.Shadow & _

                        .Font.Size & _

                        .Font.Strikethrough & _

                        .Font.Underline & _

                        .Font.Subscript & _

                        .Font.Superscript & _

                        .HorizontalAlignment & _

                        .VerticalAlignment & .MergeCells & _

                        .Orientation & .ShrinkToFit & _

                        .Height & .IndentLevel & .Locked & _

                        .Width & .WrapText & .AddIndent

                        

                If lZähler <> -1 Then

                    For t = 0 To lZähler

                        If tmpFormate(t) = tmpStr Then gefunden = True

                    Next

                End If

                If gefunden = False Then

                    lZähler = lZähler + 1

                    ReDim Preserve tmpFormate(lZähler)

                    tmpFormate(lZähler) = tmpStr

                End If

            End With

        tmpStr = ""

        Next

    Next

Next

MsgBox "Die Arbeitsmappe hat " & lZähler & " abweichende" & IIf(lZähler = 1, "s", "") & " benutzerdef. Zellformat" & IIf(lZähler <> 1, "e", "") & "!" & vbLf & "(Also " & _

    lZähler + 1 & IIf((lZähler + 1) = 1, " Format)", " Formate)"), vbInformation

End Sub Code eingefügt mit Syntaxhighlighter 1.16
Der Zugvogel
(mIsCHa Reichelt)


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: