Teilstring einer Diagramm Überschrift in einem bestimmten Format ausgeben

Computer: Software & Programmierung Office Software
#1

Hallo zusammen,

ich habe ein Problem mit der Formatierung bzw Änderung meiner Diagrammüberschriften.

Ich habe eine Datei mit ungefähr 40 Diagrammen. Bei diesen Diagrammen muss ich jeden Monat in der Diagrammüberschrift den Monatsnamen ändern. Leider ist die erste Zeile, immer unterschiedlich lang, in Schriftgröße 18 geschrieben. Die zweite Zeile, immer 63 Zeichen lang, ist in Schriftgröße 8 geschrieben. Wenn ich mit folgendem Makro:
Sub Rename()

Dim Blatt As Object, Diag As Object
Dim txt As Long

For Each Diag In Charts
txt = Diag.ChartTitle.Text
Diag.ChartTitle.Text = Replace(txt, „April“, „Mai“)

Next
End Sub

die Datei bearbeite, dann wird der Monatsname geändert, aber leider auch die Formatierung. Die Zeile in Schriftgröße 8 wird dann auch in Schriftgröße 18 dargestellt. Ich habe schon versucht, die zweite Zeile in eine Variable zu legen und dann zu formatieren, aber das klappt leider nicht.

Könnt Ihr mir helfen? Ich wäre euch sehr dankbar.

Vielen Dank. LG Martina

#2

Hallo Martina

Ich hatte mich vor einiger Zeit mit diesem „Problem“ beschäftigt und dazu etwas gefunden unter

ABER: So interessant die dortige VBA-Lösung aussieht: sie funkt leider bei mir nicht. Vielleicht schaffst Du es.

Im dortigen Code stecken zwei Fehler, die man korrigieren muss:
Statt Char(10) in Zeile 6 muss es heissen: Chr(10)
In Zeile 10 muss es heissen: „dd/mm/yyyy“ statt „dd/mm/yyy“

Ich behelfe mich nach wie vor steinzeitlich: In der Diagramm-Ueberschrift steht bei mir nur der Monat. Darunter habe ich ein Textfeld eingefügt mit dem übrigen Text mit der kleineren Schriftgrösse.

Viele Grüsse Niclaus

#3

Ich habe den Fehler entdeckt! Das Makro aus der oben erwähnten Seite muss heissen:

Sub test()
Dim TitleText As String
Dim BreakPoint As Long

TitleText = "Quality Gates - September" & Chr(10) & "From: " & _
    Format(Now, "dd/mm/yyyy")
BreakPoint = InStr(1, TitleText, Chr(10))

With ActiveChart.ChartTitle
    .Text = "Quality Gates - September" & Chr(10) & "From: " & _
        Format(Now(), "dd/mm/yyyy")
    .Characters(1, BreakPoint - 1).Font.Size = 18
    .Characters(BreakPoint + 1, Len(TitleText)).Font.Size = 8
End With
End Sub

Das beschriftet eine Diagrammüberschrift in der ersten Zeile mit Schriftgrösse 18 und in der zweiten Zeile mit Schriftgrösse 8. - Jetzt muss man das Ganze nur noch in Deine Schleife einbauen! Kriegst Du das hin?

Grüsse Niclaus

#4

Hallo Niclaus,

vielen Dank für Deine Antworten. Ich werde dies jetzt mal ausprobieren. Ich hoffe, dass ich das hinbekomme. Ansonsten würde ich mich noch einmal melden.

VG Martina

#5

Hallo Niclaus,

ich habe Deinen Vorschlag jetzt in mein Makro eingearbeitet. So sieht das Ganze jetzt aus:
Sub Rename()

Dim Diag As Object
Dim txt, txt1, txt2, BreakPoint As Long

For Each Diag In Charts
txt = Diag.ChartTitle.Text
Diag.ChartTitle.Text = Replace(txt, „April“, „Mai“)

BreakPoint = InStr(1, txt, Chr(13)) ’ Hier wird die Länge der ersten Zeile berechnet. InStr. sucht hier vom ersten Zeichen der Diagrammüberschrift bis zur Entereingabe.
txt2 = „Skonti und manuelle Korrekturbuchungen sind nicht berücksichtig“

With ActiveChart.ChartTitle
.Characters(1, BreakPoint - 1).Font.Size = 18
.Characters(BreakPoint + 1, Len(txt2)).Font.Size = 8
End With

Next
End Sub

Leider ändert er nur im ersten Diagramm die Überschrift, so wie ich es möchte. In allen anderen leider nicht. Ich brauche jetzt noch eine Schleife, mit der alle Diagrammüberschriften durchlaufen werden und die Schriftgrößen geändert werden. Bis jetzt konnte ich das leider noch nicht umsetzen. Falls Du einen Tip hättest, wäre ich Dir sehr dankbar.
VG Martina

#6

Hallo Martina
Immerhin das! :wink:
Eine Frage: Was geschieht in den andern Diagrammen: Wird dort gar nichts gemacht? Oder wenigstens der Monat gewechselt - und alles in Schriftgrösse 18 geschrieben?

Grüsse Niclaus

#7

Hallo Niclaus,

vielen Dank für Deine Hilfe und Dein Angebot mein Makro noch einmal zu prüfen. Ich habe mein Problem jetzt gelöst. Das Makro sieht folgendermaßen aus:
Sub Rename()

Dim Kopf As ChartTitle
Dim Monat As String
Dim txt, txt1, txt2, BreakPoint As Long
Dim Anzahl, s As Integer

Monat = InputBox(„Welcher Monat soll in der Überschrift stehen?“)

For s = 1 To ActiveWorkbook.Sheets.Count
For Anzahl = 1 To ActiveWorkbook.Charts.Count
Set Kopf = Charts(Anzahl).ChartTitle

If Charts(Anzahl).ChartTitle.Text Like „Skonti und manuelle Korrekturbuchungen sind nicht berücksichtigt“ Then

txt = Charts(Anzahl).ChartTitle.Text
txt = Replace(txt, „April“, Monat)
Charts(Anzahl).ChartTitle.Text = txt
Debug.Print txt

BreakPoint = InStr(1, txt, Chr(13)) ’ Hier wird die Länge der ersten Zeile berechnet. InStr. sucht hier vom ersten Zeichen der Diagrammüberschrift bis zur Entereingabe.
txt2 = „Skonti und manuelle Korrekturbuchungen sind nicht berücksichtigt“
Debug.Print BreakPoint

With Kopf
.Characters(1, BreakPoint - 1).Font.Size = 18
.Characters(BreakPoint + 1, Len(txt2)).Font.Size = 8
End With

End If
Next
Next

End Sub

Und ja, das Rename Makro hat in allen Überschriften wenigstens den Monat geändert und das erste veränderte Makro hat nur in dem ersten Diagramm die Schriften geändert. Aber jetzt läuft es genauso, wie ich es mir vorgestellt habe.

Noch einmal Danke und einen schönen Tag.

VG Martina

#8

Das freut mich! - Ein Problemchen sehe ich noch in Deinem Makro:
Du fragst den neuen Monat in einer Inputbox ab. ABER: Später folgt die Zeile:

txt = Replace(txt, "April", Monat)

Das hilft Dir ja nichts, wenn der „alte“ Monat nicht mehr der April ist! Eine Möglichkeit wäre, mit einer zweiten Inputbox zu arbeiten: „Wie heisst der bisherige Monat?“

MonatAlt = InputBox("Welcher Monat steht aktuell in der Überschrift?")

Und das bei Replace entsprechend einsetzen.

Oder: Könntest Du nicht z. B. in Tabelle1 in A1 den alten Monat und in A2 den neuen Monat erfassen? Und dann ohne Inputbox folgendes schreiben:

MonatAlt = Range("Tabelle1!A1")
Monat = Range("Tabelle1!A2")
'und dann weiter unten:
txt = Replace(txt, MonatAlt, Monat)

Viele Grüsse Niclaus

#9

Du schreibst in Deinem Makro

If Charts(Anzahl).ChartTitle.Text Like "Skonti und manuelle Korrekturbuchungen sind nicht berücksichtigt" Then

Ich verstehe das so: Es sollen nur diejenigen Diagramme eine andere Titelbeschriftung erhalten, die im Diagrammtitel u. a. folgenden Text enthalten: „Skonti und manuelle Korrekturbuchungen …“. Stimmt das??

Ich glaube, da hast Du vor „Skonti“ einen Stern vergessen. Nach meiner Meinung müsste es heissen:

If Charts(Anzahl).ChartTitle.Text Like "*Skonti und manuelle Korrekturbuchungen sind nicht berücksichtigt" Then

Weiter: Ich habe bei mir die erste For-Zeile deaktiviert - und auch ein Next ganz am Ende

For s = 1 To ActiveWorkbook.Sheets.Count

Ebenfalls deaktiviert habe ich die Zeile

Debug.Print txt

Ich glaube, beides ist nicht nötig. Jedenfalls funkt so das ganze bei mir super.

Gut, dass Du diesen Beitrag ins Forum gestellt hast! Ich habe einiges gelernt dabei!
VG Niclaus

#10

Hallo Niclaus,
vielen Dank für deine Anregungen. Das mit der zweiten Inputbox habe ich schon umgesetzt. Bezug auf eine Zelle in einer Tabelle finde ich nicht die beste Lösung, würde ich bestimmt vergessen zu ändern.
Ja, du verstehst das richtig, das Sternchen habe ich auch schon gesetzt.
Debug.print war nur zur Kontrolle der Variablen.
Vielen Dank nochmal, du hast mir sehr geholfen.
VG Martina