Thema: Abschneiden von Texten verhindern mit VBA

Hallo zusammen.
Ich habe im Archiv den Thread <<1764to1768 Abschneiden von Texten verhindern>> gefunden, der genau das löst, was mein aktuelles Problem ist.
Leider bin ich mit meinen Kenntissen über VBA noch sehr weit am Anfang. :(
hier der Link zu dem Thread:
https://www.herber.de/forum/archiv/1764to1768/1766105_Abschneiden_von_Texten_verhindern.html#0

Das Problem:

Ich nutze 2 Arbeitsblätter.
-> Tabelle 1: hier pflege ich in einer Tabelle "Anfangsdatum" "Enddatum" und "Vorhaben"
-> Tabelle 2: hier habe ich einene Kalender, der mir die Bereich von Tabelle 1 farblich (über Formatierung) und die Vorhaben aufzeigt.

Da in allen Zellen (Tabelle2) Formeln stehen, wird der Text des Vorhabens abgeschnitten.
kann bitte jemand bei diesem "alten Fall" unter die Arme greifen und den Code von dem Archiv-Thread umbasteln?

Anhang: https://www.herber.de/bbs/user/177374.xlsx

das ist der Code aus dem Thread:

Option Explicit
Sub FuelleAus()
Dim rZelle As Range
Dim sBereich As String
Dim WSh As Worksheet

sBereich = "$G$13:$AZ$15" 'Hier den Bereich festlegen

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set WSh = Sheets("Tabelle1")
For Each rZelle In WSh.Range(sBereich)

With rZelle
If (WSh.Cells(WSh.Range(sBereich).Row - 1, .Column).Value - 1) _
= (WSh.Cells(.Row, "D").Value - Cells(.Row, "C").Value) Then
rZelle.Value = WSh.Cells(.Row, "B").Value
Else
rZelle.Value = ""
End If
End With

Next rZelle
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Es wäre voll toll, wenn sich dem jemand annehmen könnte :D <3


MfG David

Hallo David,

was heißt der Text des Vorhabens wird abgeschnitten? Der Text ist mit Formel oder als Festtext gleichlang?

LG, Alexandra

Moin.
Du kannst die Schriftgrösse reduzieren
Gruss Gerd

Hi
probier mal folgendes Makro
es trägt die Daten aus der Tabelle1 in die Tabelle2 ein
es übernimmt ebenso die Hintergrund- und Schriftfarbe für die einzelnen Tabellen aus der Zelle, in der auch der Name der Person steht (die Zelle über der Tabelle), dh wenn du diese Zelle entsprechend formatierst, kannst du dir die bedingten Formatierungen sparen:

Sub test()

Dim lo As ListObject

Dim Person2 As Range

Dim Person1 As Range

Dim ze As Range

Dim x As Long

Dim y As Long

For Each lo In Sheets("Tabelle1").ListObjects

    Set Person1 = lo.Range(1).Offset(-1, 0)

    If Person1.Value = "" Then

        lo.Range.Select

        MsgBox "Achtung, Tabelle ohne Namen vorhanden!"

    Else

        With Sheets("Tabelle2")

            Set Person2 = .Columns(1).Find(Person1.Value, lookat:=xlWhole, LookIn:=xlValues)

            If Person2 Is Nothing Then

                MsgBox "Bitte Kalenerzeile für """ & Person1.Value & """ anlegen"

            Else

                With Person2.Offset(0, 1).Resize(1, .UsedRange.Columns.Count - 1)

                    .ClearContents

                    .Interior.Color = xlNone

                    .Font.Color = xlNone

                End With

                For Each ze In lo.DataBodyRange.Rows

                    x = ze.Cells(1, 1).Value - DateSerial(.Range("A1").Value, 1, 1) + 1

                    y = ze.Cells(1, 3).Value - ze.Cells(1, 1).Value + 1

                    If x >= 1 And x <= .UsedRange.Columns.Count + 1 Then

                        Person2.Offset(0, x) = ze.Cells(1, 4).Value

                        With Person2.Offset(0, x).Resize(1, y)

                            .HorizontalAlignment = xlCenterAcrossSelection

                            .Interior.Color = Person1.Interior.Color

                            .Font.Color = Person1.Font.Color

                        End With

                    End If

                Next

            End If

        End With

                

    End If

Next

End Sub

damit dein Kalender immer aktuell ist, würde ich das Makro das Deactivate-Event des Sheets Tabelle1 auslösen.
damit ist dann sichergestellt, dass du die aktuellen Änderungen bekommst, wenn du von der Eingabemaske auf den Kalender wechselst.

Gruß Daniel

Guten Morgen Daniel,

danke für die schnelle Antwort. Das schaut schon mal soweit echt Top aus :D.

Kann ich da die Farben noch irgendwo selbst festlegen, bzw ändern? -> Bei Person4 bleibt der Bereich Weiß.

Ein Problem habe ich noch:
wenn es sich nur um 1 Tag handelt und der Text länger sein sollte, wird dieser trotzdem noch "abgeschnitten"




Grüße,

David

Hi

Die Farben und Namen legst du auf der Eingabeseite fest.
Dort muss für jede Person ein eigenes Listobjekt (intelligente Tabelle) angelegt sein.
Name und Farben müssen in der Zeile direkt über dem Listobjekt in der ersten Zelle stehen. Der Name muss dann im Kalenderblatt in der Spalte A wiederzufinden sein.

Es wird auch nichts abgeschnitten.
Es ist nur weiße Schrift auf weißem Hintergrund schlecht lesbar.

Guten Morgen,

Echt Super, ich danke dir :) Funktioniert genau so wie ich es haben wollte.


Grüße,

David

und wie kann ich die Namen der Personen ändern, sodass der Code trotzdem noch funktioniert?

Grüße,

David

Hallo cycsu11,
danke für die schnelle Antwort.

hier ein Bild mit Erklärung :)