Posts Tagged ‘Visual Basic’

Mittwoch, 18. Juli 2012

Microsoft Excel beschwert sich über „Too many different cell formats“

Es vergeht keinen Tag am Bürorechner, an welchem man nicht eine neue Fehlermeldung in Microsoft-Produkten präsentiert kriegt – und sich beim der Recherche zum Fehler wieder einmal wünschen würde, jeden einzelnen Entwickler in Redmond einen unendlich langsamen Tod sterben zu lassen.

Microsoft gibt seinen Endanwendern die grandiose Möglichkeit, jede einzelne Tabellenzeile mit einem individuellen Format zu versehen. Rahmendicke, Hintergrundfarben, Schriftschnitte können individuell definiert werden. Und jede so formatierte Zelle ergibt ein neues Zellformat, welches in der Excel-Datei zentral gesichert wird.

Das Schöne daran ist, dass es offenbar Endanwender in Schwellenländern gibt, welche es bei der Erledigung von ausgelagerten Arbeiten fertigbringen, annähernd 65’000 Formate in einer einzigen Excel-Datei mit ca. 20 Sheets unterzubringen. Heilige Shiva! Das Problem: Excel kriegt massiven Schluckauf, sobald diese Limite (wahrscheinlich mit der Grenze für unsigned integers) erreicht ist – nichts geht mehr, keine Zellformatierung, kein Zusammenführen von Zellen, ja nicht einmal kopieren geht mehr. Und dazu die lapidare Fehlermeldung:

Too many different cell formats.

Die Lösung ist im Grunde simpel: Das Dokument muss analysiert und nicht verwendete Styles gelöscht werden. Dafür gibt es mittlerweile unzählige Varianten, davon hier nur drei:

  • Kommerziell. 39 Dollar will der Entwickler des Style Reduction Tools haben, damit die Excel-Endanwender wieder arbeiten und nicht Excel-Fehlermeldungen wegglicken und Abstürze überwinden müssen.
  • Handgestrickt. Auf Stackoverflow findet sich VBA-Code, welchen man mit entsprechenden Kenntnissen über eine Excel-Datei laufen lassen kann. Fallstricke:
    • .xlsx-Dateien müssen zuerst in .xlsm-Dateien umkonvertiert werden
    • Danach muss man das Developer-Ribbon aktivieren
    • Anschliessend fügt man ein Modul in die Excel-Datei ein
    • Nun kopiert man den Source-Code in das Modul hinein
    • Schlussendlich muss unter Tools > References noch „Microsoft Scripting Runtime“ aktiviert werden
    • Jetzt kann man die Funktion starten, fliegt aber rasch auf die Schnauze, weil Dim iStyleCount As Integer als Integer definiert ist und deshalb überläuft
    • Nachdem der Laptop für ca. 20-30 Minuten wie totgefroren ist, erscheint dann die erlösende Meldung: Statt der ursprünglich 64999 gefundenen Styles sind nach der Bereinigung nur noch effektiv 10 verwendete Stück im Dokument
  • Beschleunigt. Da sich Microsoft des Problems bewusst ist, verlinken sie in ihrem KB-Artikel zur Fehlermeldung auf ein kostenfreies Tool eines unabhängigen Entwicklers (.NET4.0 version of the XLStylesTool is now available), welcher die Styles auf OOXML-Ebene säubert, was einen massiven Geschwindigkeitsgewinn gegenüber der VBA-Version ermöglicht. WICHTIG: Nachdem die Applikation gestartet und die Datei ausgewählt wurde, muss zwingend [x] „Commit changes …“ ausgewählt werden, damit die Anpassungen gespeichert werden können.

VBA-Code

Via: Too Many Different Cell Formats, ergänzt/überarbeitet von eMeidi.com

' Description:
'    Borrowed largely from http://www.jkp-ads.com/Articles/styles06.asp
' Additional debug message piping to .txt file in C:\ by eMeidi.com
' Bugfixing iStyleCount from Integer to Long by eMeidi.com

Option Explicit

' Description:
'    This is the "driver" for the entire module.
Public Sub DropUnusedStyles()

    Dim styleObj As Style
    Dim rngCell As Range
    Dim wb As Workbook
    Dim wsh As Worksheet
    Dim str As String
    Dim iStyleCount As Long
    Dim dict As New Scripting.Dictionary    ' <- from Tools / References... / "Microsoft Scripting Runtime"

    ' wb := workbook of interest.  Choose one of the following
    ' Set wb = ThisWorkbook ' choose this module's workbook
    Set wb = ActiveWorkbook ' the active workbook in excel
    
    Dim strPath As String
    strPath = "C:\excelFormatCleanerDebug.txt"
    Dim f
    f = FreeFile()
    Open strPath For Output As f
    'Print #f, Text

    Debug.Print "BEGINNING # of styles in workbook: " & wb.Styles.Count
    'GoTo Bla
    
    ' dict := list of styles
    For Each styleObj In wb.Styles
        str = styleObj.NameLocal
        iStyleCount = iStyleCount + 1
        Call dict.Add(str, 0)    ' First time:  adds keys
        'Debug.Print str & ", ";
        Print #f, str & ", "
    Next styleObj
    Debug.Print "  dictionary now has " & dict.Count & " entries."
    ' Status, dictionary has styles (key) which are known to workbook
    'GoTo Bla
    
    ' Traverse each visible worksheet and increment count each style occurrence
    For Each wsh In wb.Worksheets
        If wsh.Visible Then
            For Each rngCell In wsh.UsedRange.Cells
                str = rngCell.Style
                dict.Item(str) = dict.Item(str) + 1     ' This time:  counts occurrences
                Print #f, str & "+1"
            Next rngCell
        End If
    Next wsh
    ' Status, dictionary styles (key) has cell occurrence count (item)


    ' Try to delete unused styles
    Dim aKey As Variant
    On Error Resume Next    ' wb.Styles(aKey).Delete may throw error

    For Each aKey In dict.Keys

        ' display count & stylename
        '    e.g. "24   Normal"
        Debug.Print dict.Item(aKey) & vbTab & aKey
        Print #f, dict.Item(aKey) & vbTab & aKey

        If dict.Item(aKey) = 0 Then
            ' Occurrence count (Item) indicates this style is not used
            Call wb.Styles(aKey).Delete
            If Err.Number <> 0 Then
                Debug.Print vbTab & "^-- failed to delete"
                Err.Clear
            End If
            Call dict.Remove(aKey)
        End If

    Next aKey

    Debug.Print "ENDING # of style in workbook: " & wb.Styles.Count
Bla:
End Sub

Tags: , , , , , , ,
Labels: IT, Programmierung

Keine Kommentare | neuen Kommentar verfassen

Donnerstag, 8. März 2012

Bedingte Formatierung in Microsoft Access mit mehr als drei Prüfwerten

Von Microsoft ist man Benutzerunfreundlichkeit gewohnt, und so verhält es sich auch mit der bedingten Formatierung (Conditional Formatting) von Reporten in Microsoft Access: Der Wert eines Feldes kann mit den GUI-Tools nur auf drei Stati gleichzeitig geprüft werden.

Zum Glück kann man auf VBA ausweichen. Hierzu öffnet man die Design View des Reports, wählt die Sektion „Detail“ mit Klick auf dessen Balken aus, wechselt im Eigenschaftsfeld auf Events und erstellt dort für das Ereignis „On Format“ eine VBA-Prozedur mit dem Code Builder.

Dort kann man als geübter Entwickler dann mit dem Select Case-Konstrukt arbeiten:

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    Dim sStatus As Variant 'To account for null values
    sWert = Me!Wert
    
    Select Case sWert
    Case "Yes"
        ' Grün
        cColor = RGB(0, 255, 0)
    Case "In most cases"
        ' Gelb
        cColor = RGB(255, 255, 0)
    Case "In almost half the cases"
        ' Orange
        cColor = RGB(255, 215, 0)
    Case "In a few cases"
        ' Fuchsia
        cColor = RGB(255, 0, 255)
    Case "No"
        ' Rot
        cColor = RGB(255, 0, 0)
    Case "Not applicable", "N/A"
        cColor = RGB(192, 192, 192)
    Case Else
        cColor = RGB(255, 255, 255)
    End Select
    
    Debug.Print "Setting Color to " & cColor & " based on " & sWert
    Me!Wert.BackColor = cColor
End Sub

Ein Nachteil hat das ganze aber: Die Hintergrundfarbe wird nur in der Druckvorschau angezeigt. Auch das wieder: Typisch Microsoft. Unbrauchbare Software aus dem letzten Jahrhundert.

Tags: , , , ,
Labels: Programmierung

Keine Kommentare | neuen Kommentar verfassen

Freitag, 17. Februar 2012

Iteration über alle in eine Word-Datei eingebette OLE-Objekte

In einem Word-Dokument befinden sich ein Dutzend OLE-Objekte, sprich in die Word-Datei eingebettete Dateien wie PDFs, TXTs und XLSs.

Folgendes Visual Basic-Script iteriert über die Shapes und InlineShapes in einem Dokument und gibt den Dateinamen aus:

Sub emeidiListEmbeddedFiles()
    Debug.Print "Shapes in ActiveDocument.Shapes.Count: " & ActiveDocument.Shapes.Count
    Debug.Print ""
    
    For Each Shape In ActiveDocument.Shapes
        With Shape
            With .OLEFormat
                'Debug.Print "    .IconLabel: " & .IconLabel
                Debug.Print .IconLabel
            End With
        End With
    Next
    
    Debug.Print "Shapes in ActiveDocument.InlineShapes.Count: " & ActiveDocument.InlineShapes.Count
    Debug.Print ""
    
    For Each Shape In ActiveDocument.InlineShapes
        With Shape
            With .OLEFormat
                'Debug.Print "    .IconLabel: " & .IconLabel
                Debug.Print .IconLabel
            End With
        End With
    Next
    
    
End Sub

Das Script kann problemlos angepasst und erweitert werden, um die Eigenschaften der entsprechenden Objekte zu verändern.

Tags: , , ,
Labels: Programmierung

Keine Kommentare | neuen Kommentar verfassen