Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
356to360
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
356to360
356to360
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Schriftart in Worksheet komplett ersetzen

Schriftart in Worksheet komplett ersetzen
29.12.2003 21:15:55
Patrik
Hallo zusammen

Brauche wieder einmal eure Hilfe. Eure Hilfesleistungen waren echt genial bis anhin!

Nun zu zwei Problemen im Zusammenhang mit Schriften:
- Wie finde ich heraus, welche Schriftarten in einem Workbook alle verwendet werden?

- Wie ersetze ich eine Schriftart überall (im ganzen Workbook), wo diese verwendet wurde, komplett durch eine andere [Auf einer Tabelle können mehrer Schriftarten vorkommen - welche alle bis auf eine erwünscht sind: möchte z.B. exotische Schriftart "Granium" durch Arial ersetzen]?

Lösung mittels Standardfunktionen oder VBA Code willkommen :-)

Danke & Gruss
Patrik

P.S.: Stehht im Zusammenhang mit meinen "too many different cell formats" Error.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schriftart in Worksheet komplett ersetzen
29.12.2003 21:32:47
Josef Ehrensberger
Hallo Patrik,

schreib diesen Code in ein allgemeines Modul und
lass ihn laufen.
(kann aber bei einer umfangreichen Mappe eine weile dauern!)



Sub SchriftartenErsetzen()
Dim rng As Range
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
For Each rng In wks.UsedRange
If rng.Font.Name = "Granium" Then
rng.Font.Name = "Arial"
End If
Next
Next
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5


Gruß Sepp
Anzeige
AW: Schriftart in Worksheet komplett ersetzen
29.12.2003 22:23:17
Patrik
Hi Sepp

Vielen Dank! damit wären 50% beantwortet.

Wie finde ich heraus, welche Schriftarten in einem Workbook alle verwendet werden? Muss dazu auch VB Code geschrieben werden?

Danke & Gruss
Patrik
AW: Schriftart in Worksheet komplett ersetzen
29.12.2003 22:40:09
Josef Ehrensberger
Hi Patrik,

ein weiterer Code, kann auch ein weilchen dauern!



Sub alleSchriftarten()
'die ausgabe der verwendeten schriftarten (ausser Standard-Schrift)
'erfolgt im Direkt-Fenster. >Ansicht > Direktfenster
Dim rng As Range
Dim wks As Worksheet
Dim str As String
Dim standard As String
standard = "Arial" 'hier standardschriftart der Tabelle eingeben
For Each wks In ThisWorkbook.Sheets
For Each rng In wks.UsedRange.Cells
If rng.Font.Name <> standard And InStr(1, str, rng.Font.Name) = 0 Then
str = str & rng.Font.Name & vbLf
End If
Next
Next
Debug.Print str
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5


Gruß Sepp
Anzeige
AW: Schriftart in Worksheet komplett ersetzen
29.12.2003 22:53:06
Patrik
Der obige Code funktioniert eigentlich - bis auf eine Ausnahme: Bereiche, welche keinen Inhalt und keine Formate haben, denen aber die zu ersetzende Schriftart zugewiesen wurde, werden nicht ersetzt.

Test: Neues Workbook, Bereich markieren, Schriftart zuweisen, Sub aufrufen - die Schriftart wird nicht geändert. Aber auch aus diesen Bereichen möchte ich die Schriftart entfernen, um beim öffnen auf Arbeitsstationen ohne die Schriftart keine Meldung zu erhalten.

Eine Erklärung dazu (dürfte an UsedRange liegen, oder )? Wie muss der code geändert werden? wirklich mittels For.. Schleife durch alle Zellen gehen? Dauert ja ewig...

Danke und Gruss Patrik
Anzeige
AW: Schriftart in Worksheet komplett ersetzen
29.12.2003 23:00:22
Josef Ehrensberger
Hi,

ja Du hast recht, dann musst Du das Makro alle Zellen abarbeiten lassen.

Würde ich aber nicht tun, weil erstens das ganze wirklich "ewig" dauert
und zweitens, je nach performance deines Rechners es durchaus sein kann,
das Excel sich "aufhängt".

Ich denke es währe warscheinlich klüger, wenn Du zuerst die Schriftart
für alle Zellen auf Standart zurücksetzt und dann, bei den Zellen wo es
unbedingt nötig ist , die entsprechende Schriftart wählst.

Grus Sepp
AW: Schriftart in Worksheet komplett ersetzen
29.12.2003 23:11:45
Patrik
Danke Sepp, dann werde ich darauf verzichten!

Gruss Patrik
Test....
29.12.2003 23:32:14
Ramses
Hallo Patrick

Ich habe das gerade mal getestet:
5 Tabellen mit jeweils 327'680 ( 5 Spalten à 65536 Zellen ) formatierten Zellen.
Da braucht das Makro pro Tabelle 54 Sekunden.

Ich weiss nicht wie gross deine Tabelle ist, aber das sollte vertretbar sein.

Hier noch meine Varianten. Sind ähnlich aufgebaut wie von Josef:


Option Explicit

Sub Find_TextStyle()
'by Ramses
'findet alle verwendeten Schriftarten in einer Mappe
'und listet diese in einer Tabelle auf
Dim i As Integer, myC As Range, x
Dim tarWks As Worksheet, curWks As Worksheet, c
'Tabelle wo die verwendeten Schriftarten ausgegeben werden sollen
Set tarWks = Worksheets("Tabelle3")
Debug.Print Format(Now, "hh:mm:ss")
x = Now
For Each curWks In ThisWorkbook.Sheets
    If curWks.Name <> tarWks.Name Then
        Debug.Print curWks.Name
        For Each myC In curWks.UsedRange
            ''500 sollte reichen für die Schriftarten :-))
            With tarWks.Range("a1:a500")
                Set c = .Find(myC.Font.Name, LookIn:=xlValues)
                If c Is Nothing Then
                    tarWks.Cells(Cells(65536, 1).End(xlUp).Row + 1, 1) = myC.Font.Name
                End If
            End With
        Next
    End If
Next
Debug.Print Format(Now - x, "hh:mm:ss")
End Sub


Sub Change_Font()
'by Ramses
'findet alle verwendeten Schriftarten in einer Mappe
'und listet diese in einer Tabelle auf
Dim i As Integer, myC As Range, x
Dim tarWks As Worksheet, curWks As Worksheet, c
'Tabelle wo die verwendeten Schriftarten ausgegeben werden sollen
Set tarWks = Worksheets("Tabelle3")
Debug.Print Format(Now, "hh:mm:ss")
x = Now
For Each curWks In ThisWorkbook.Sheets
    If curWks.Name <> tarWks.Name Then 'Tabelle mit dem Ziel
        Debug.Print curWks.Name
        For Each myC In curWks.UsedRange
            If myC.Font.Name <> "Arial" Then
                myC.Font.Name = "Arial"
            End If
        Next
    End If
Next
Debug.Print Format(Now - x, "hh:mm:ss")
End Sub 
     Code eingefügt mit Syntaxhighlighter 1.16




Gruss Rainer
Anzeige
AW: Test....
30.12.2003 02:04:59
Patrik
Danke Ramses. Werde es mal ausprobieren. morgen .-)

Meine Tabelle ist riesig: 25 Sheets, Pro Sheets zwischen 100-200 Spalten à je 500 Zeilen.

Sollte aber dennoch gehen - ausser Excel verabschiedet sich.

Eine Knacknuss ist aber noch nicht gelöst, ist mir soeben aufgefallen: Wird in einer Zelle erst eine Schriftart verwendet und für einige Informationen dann die gesuchte andere Schrift (Bsp: Hallo Fritz, wobei Hallo mit Arial und Fritz mit gesuchter Schriftart), so wird die gesuchte Schrift nicht ersetzt. Wie schafft man dem Abhilfe?

Danke und Gruss
Patrik
Anzeige
Schriftart
30.12.2003 09:41:02
Ramses
Hallo Patrik

das Verhalten ist bei mir nicht nachvollziehbar.
Auch wenn ich einzelne Zeichen mit einer anderen Schriftart formatiere, wird diese bei Verwendung von

myC.Font.Name = "Arial"

die Schriftart der ganzen Zelle zugwiesen

By the way:
200 Spalten * 500 Zeilen = 100'000 Zellen

Das heisst bei meinem simulierten Test entspricht eine Tabelle 327'680 Zellen, also ungefähr 3,2 deiner Tabellen. Meine 5 Tabellen also ungefähr 16 deiner Tabellen.
Dann sollte deine Mappe nach 10 Minuten max korrigiert sein ;-))

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige