Hallo Wissende,
inzwischen habe ich mir eine Lösung in Excel-Vba zusammengebastelt, mit deren Hilfe man herausfinden kann, ob eines der Zeichen 0 - 65536 jeder Schriftart druckbar/darstellbar ist oder nicht.
Leider ist die Lösung sehr langsam, ca. eine Sekunde pro Zeichen, also 18 Stunden pro Schriftart
Deshalb meine Hoffnung, daß eine gleichwertige VB-Lösung schneller ist:smile:
Die Vba-Lösung macht folgendes, alle 65536 Zeichen stehen in einer Spalte untereinander, diese Spalte wird durchlaufen und
a) jeder Zellinhalt (=Zeichen) wird als jpg-Bild gespeichert
b) alle nicht druckbaren/darstellbaren Zeichen werden von Excel als
Quadrat dargestellt, alle als Bild gespeicherten Quadrate haben
die gleiche Dateigröße.
c) Diese Zellen/Zeichen werden in der Nachbarzelle rechts gekennzeichnet
d) Wenn ich nun nach dieser Nachbarzelle die fertige Tabelle sortiere
habe ich sauber als Block alle darstellbaren Zeichen.
Vb müßte jetzt was adäquates tun, alle Zeichen von 0 - 65535 einzeln als jpg-Datei abspeichern, die Dateigröße ermitteln, vergleichen mit einem festen Vorgabewert und dann die darstellbaren Zeichen irgendwie in einer Liste sammeln und ausgeben/abspeichern.
Andere, schnellere ösungsansätze sind natürlich auch sehr gerne gesehen *gg*
Im Anhang ist der Vba-Code, der ist frisch zusammengebastelt und bietet noch Tuning-Pontial, das kriege ich schon hin, mir geht es um eine VB-Lösung.
Danke ^ Gruß
Reinhard
Option Explicit
'
Sub Nichtdruckbar()
Dim N As Long
Call Liste
If Dir("H:\Buchstaben", vbDirectory) = "" Then MkDir "h:\Buchstaben"
Application.ScreenUpdating = False
Worksheets("Tabelle1").Columns("B:smiley:").ClearContents
For N = 32 To 65535
Call prcExportTablecopy(N, "H:\Buchstaben")
Application.StatusBar = N & "/65536"
Next N
Application.ScreenUpdating = True
End Sub
'
Public Sub prcExportTablecopy(ByVal N As Long, Pfad As String)
Dim objChart As Chart, PfadDatei As String
Dim objChartObject As ChartObject
Dim objShape As Shape
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
.Select
.Cells(N, 1).Select
.Cells(N, 1).Copy
.Pictures.Paste Link:=True
Set objShape = .Shapes(.Shapes.Count)
End With
Application.CutCopyMode = False
objShape.CopyPicture Appearance:=2, Format:=-4147
Set objChart = Charts.Add
Set objChartObject = objChart.ChartObjects.Add(0, 0, \_
objShape.Width \* 0.85, objShape.Height \* 0.85)
PfadDatei = Pfad & "\" & Right("00000" & N, 5) & ".jpg"
With objChartObject.Chart
.Paste
.Export Filename:=PfadDatei, FilterName:="JPG", Interactive:=False
End With
'Worksheets("Tabelle1").Cells(N, 3) = FileLen(PfadDatei)
If FileLen(PfadDatei) = 1007 Then Worksheets("Tabelle1").Cells(N, 2) = "nix"
Kill PfadDatei
Application.DisplayAlerts = False
objChart.Delete
objShape.Delete
Application.DisplayAlerts = True
'Set objChart = Nothing
'Set objChartObject = Nothing
'Set objShape = Nothing
' With UserForm1
' .Image1.Picture = LoadPicture(ThisWorkbook.Path & \_
' "\Bild.jpg")
' .Show
' End With
End Sub
'
Sub Liste()
Dim N As Long
Application.ScreenUpdating = False
For N = 32 To 65535
Cells(N, 1) = ChrW(N)
Next N
Application.ScreenUpdating = True
End Sub