Thema Datum  Von Nutzer Rating
Antwort
Rot Schriftartenliste
 21.07.2014 13:29:27 Karli
NotSolved

Ansicht des Beitrags:
Von:
Karli		 Datum:
21.07.2014 13:29:27		 Views:
1607		 Rating:
     
Antwort:
  Ja
Thema:
Schriftartenliste

Einen kühlen guten Tag!

Bei den Temp. nach zu denken ist nicht leicht, aber dann noch über anderer Leuts Sorgen ... na ja vielleicht klappt da doch noch was:

Per VBA habe ich eine Exceltabelle erzeugen lassen, die mir neben der lfd. Nummer den Namen eine eine beliebige Schriftprobe in beliebiger Größe erzeugt.

Wenn ich aber die eine oder andere Schriftart z.B in der Größe in der Tabelle ändern möchte erscheint folgende mir unbekannte Meldung von EXCEL:

"Keine weiteren neuen Schriftarten dürfen hinzugefügt werden. Schließen Sie andere Dokumente und wiederholen Sie den Vorgang."

 

Änderungen z. B. an der Größe sind unsinnig, da ein größer zu kleineren und ein kleiner auch zu größeren Schriften führt :-(  Ich bin da völlig ratlos und vermute in der VBA einen gravierenden Fehler gemacht zu haben.

Hier ein Ausschnitt:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Private Sub CommandButton1_Click()      'Start
Dim z As Long
Dim start As String
Dim SchriftNr, ix, x As Integer, Schriftliste As Object
Set Schriftliste = Application.CommandBars("formatting").FindControl(ID:=1728)
start = Time
On Error Resume Next
 
 Application.ScreenUpdating = False
'[A:C].ClearContents
Application.StatusBar = "In Arbeit: "
 
ix = 1
 
For SchriftNr = 0 To Schriftliste.ListCount - 1
    Cells(SchriftNr + 1, 1).Value = SchriftNr + 1
    Cells(SchriftNr + 1, 2).Value = Schriftliste.List(SchriftNr + 1)
    Cells(SchriftNr + 1, 3).Value = UserForm1.TextBox2
    Cells(SchriftNr + 1, 3).Font.Name = Schriftliste.List(SchriftNr + 1)
    Cells(SchriftNr + 1, 3).Font.Size = Val(UserForm1.TextBox1)
    'Range("B" & SchriftNr + 1).Font.Size = 24 'Val(UserForm1.TextBox1)
    UserForm1.Label6 = SchriftNr
     
    If ix < 120 Then
        Application.StatusBar = Application.StatusBar & "#"
        ix = ix + 1
    Else
        ix = 1
        Application.StatusBar = "In Arbeit: "
    End If
DoEvents
Next
 
 
Application.ScreenUpdating = True
 
 
    Range("B1").Select
    Selection.EntireRow.Insert
    ActiveCell.FormulaR1C1 = "N A M E"
    Selection.Font.Bold = True
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "S C H R I F T E N M U S T E R"
    Selection.Font.Bold = True
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "L f d - N r."
    Selection.Font.Bold = True
    Range("B1").Select
     
    Range("A1:C1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("A:B").Select
    Columns("A:B").EntireColumn.AutoFit
        Rows("1:1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A2").Select
    Range("A1").Select
     
 Application.StatusBar = "S C H R I F T E N L I S T E   W U R D E   E R S T E L L T !"
 
    UserForm2.Caption = "Start: " & start & " -> Ende: " & Time 'Initialisierung
    UserForm2.Show
    UserForm2.Caption = "Start: " & start & " -> Ende: " & Time
    Unload UserForm2
    Application.DisplayFormulaBar = True    ' Bearbeitungsleiste sichtbar
Unload UserForm1

 

Es wäre schön wenn ein Spezialist das "Machwerk" begutachten könnte. Ich bin mir auch im Klarem, dass nicht alles "effektiv" ist, aber seis drum, es macht mir Spaß und Freude.

Schon jetzt vielen Dank an den/die Spezialisten.

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Schriftartenliste
 21.07.2014 13:29:27 Karli
NotSolved