Höhe einer Spalte an Zeichenlänge anpassen

Bild

Betrifft: Höhe einer Spalte an Zeichenlänge anpassen
von: Andres
Geschrieben am: 04.11.2015 09:12:21

Moin,
ich hab ein kleines Problem. Ich erstelle über ein VBA Programm Checklisten. Also ich habe eine Datenbank selbst in Excel und je nach Eingaben kopiert mir Excel die notwendigen Passagen in eine neue Excel Tabelle.
Alles super, so jetzt will ich aber das die Zellenhöhen angepasst werden. Über die AutoFit Funktion passt das alles nicht. wenn da zu viele Zeichen in einer Zeile sind, dann kann man das nicht lesen. Also hab ich mir gedacht ich schreibe eine schleife in der er die Zeichenlänge ausliest und daran die Zellenhöhe anpasst. Das was ich jetzt habe sieht so aus:
Dim iCounter As Integer
Dim strLaenge As String
For iCounter = 1 To 1000
strLaenge = Len(Cells(iCounter, 1))
If strLaenge > 20 Then
Cells(iCounter, 1).Select
Selection.RowHeight = 20
End If
Next iCounter
Leider macht er aber nichts. Hat jemand da eine Idee?

Bild

Betrifft: AW: Höhe einer Spalte an Zeichenlänge anpassen
von: Rudi Maintaire
Geschrieben am: 04.11.2015 09:31:07
Hallo,
Dim strLaenge As Integer
Gruß
Rudi

Bild

Betrifft: AW: Höhe einer Spalte an Zeichenlänge anpassen
von: Andres
Geschrieben am: 04.11.2015 09:58:36
Ja top das wars.
Jetzt hat sich aber folgendes Problem aufgetan. Danach kommt dieser Code:
'PDF erstellen
strPfad = ThisWorkbook.Path
ChDir strPfad
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strName & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Ich erstelle das neue Dokument also als PDF. Jetzt versucht er aber alles als PDF zu erstellen was nach Zelle 1000 kommt. Was ja nicht sein soll.
Hier auch eine Idee?

Bild

Betrifft: als PDF exportieren
von: Rudi Maintaire
Geschrieben am: 04.11.2015 10:01:05
Hallo,
Hier auch eine Idee?
Ja.
Leg den Druckbereich fest.
Gruß
Rudi

Bild

Betrifft: Nochmal von neu
von: Andres
Geschrieben am: 04.11.2015 10:41:10
Moin, danke erstmal für die Hilfe,
aber ich glaube ich mache mir grad mehr kaputt, als das es hilft :D . Es hatte ja am Anfang alles geklappt und ich wollte nur die Zeilenhöhe anpassen. Mein Code sieht mitlerweile so aus:
'Variabeln
strName = "blubb"
Dim strName As String
Dim wsNew As Worksheet
Dim strPfad As String
Dim iCounter As Integer
Dim strLaenge As Integer
'Blatt einrichten
Sheets(strName).Columns("A:A").ColumnWidth = 45
iCounter = 1
For iCounter = 1 To 200
strLaenge = Len(Cells(iCounter, 1))
If strLaenge > 90 Then
Sheets(strName).Cells(iCounter, 1).Select
Selection.RowHeight = 50

ElseIf strLaenge = 90 Then
Sheets(strName).Cells(iCounter, 1).Select
Selection.RowHeight = 50

ElseIf strLaenge = 0 Then
Sheets(strName).Cells(iCounter, 1).Select
Selection.RowHeight = 0

Else
Sheets(strName).Cells(iCounter, 1).Select
Selection.RowHeight.AutoFit
End If
Next iCounter

'PDF erstellen
strPfad = ThisWorkbook.Path
ChDir strPfad
ActiveSheet.PageSetup.PrintArea = "A1:D" & Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Row
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strName & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'Variabeln löschen
Set wsNew = Nothing
strName = ""
strPfad = ""
strLaenge = 0
Die Probleme sind gerade folgende:
Die neue Tabelle wird erst ab Zeile 200 angezeigt, ich kann auch nicht nach oben scrolleb. Um auf die vorherigen Zeilen zu kommen muss ich ersteinmal auf das kleine Graue Kästchen was über der Zeile 200 dann ist ein paar mal draufklicken.
Die Zeilen von 1 - 200 haben aber dann nicht die eingestellten höhen, sondern wie das aussieht nur AutoFit, also das was ich davor auch hatte.
Dann bei der Erstellung der PDF bekomme ich nur ein weißes Blatt raus, ich denke der Druckbereich ist einfach falsch eingestellt. Die Idee dahinter war, das er einfach von A1 bis D[x] geht, wobei [x] die erste freie Zelle ist.
Ich hoffe mir kann jemand weiterhelfen.
Lg

Bild

Betrifft: AW: Nochmal von neu
von: Andres
Geschrieben am: 04.11.2015 11:35:41
Nachtrag.
Anscheinend bekommt er die Zeichen nicht richtig gezählt. Ich habe folgenden Code:
ElseIf strLaenge = 0 Then
Sheets(strName).Cells(iCounter, 1).Select
Selection.RowHeight = 0
auf den geändert:
ElseIf strLaenge = 0 Then
Sheets(strName).Cells(iCounter, 1).Select
Selection.RowHeight = 30
und diesen raus genommen:
'ActiveSheet.PageSetup.PrintArea = "A1:D" & Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Row
Jetzt kopiert er auch wieder alles vernüntig in die PDF nur alle höhen sind auf 30. D.h.: Er kann die Zeichenzahl nicht erkkennen.

Bild

Betrifft: AW: Nochmal von neu
von: Rudi Maintaire
Geschrieben am: 04.11.2015 12:06:11
Hallo,
teste mal:

Sub aaa()
  Dim strName As String
  Dim iCounter As Integer
  strName = "blubb"
  Application.ScreenUpdating = False
  'Blatt einrichten
  With Sheets(strName)
    .Columns("A:A").ColumnWidth = 45
    .Columns("A:A").WrapText = True
    .Rows.AutoFit
    For iCounter = 1 To 200
      Select Case Len(.Cells(iCounter, 1))
        Case Is >= 90: .Rows(iCounter).RowHeight = 50
        Case Else: .Rows(iCounter).AutoFit
      End Select
    Next iCounter
    
    'PDF erstellen
    
    .PageSetup.PrintArea = _
      "A1:D" & .Cells(Rows.Count, 1).End(xlUp).Row
    .ExportAsFixedFormat _
      Type:=xlTypePDF, _
      Filename:=ThisWorkbook.Path & "\" & strName & ".pdf", _
      Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=True
  End With
End Sub
Gruß
Rudi

Bild

Betrifft: AW: Nochmal von neu
von: Andres
Geschrieben am: 04.11.2015 13:37:47
PERFEKT!
Funktioniert wie gewünscht.
Danke Danke Danke :)

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Höhe einer Spalte an Zeichenlänge anpassen"