Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro funktioniert nicht richtig

Makro funktioniert nicht richtig
14.11.2006 11:14:08
Gesa
Hallo,
habe ein Makro (Ereignis) welches verbundene Zeilen automatisch nach Eingabe vergrößert. Wenn die Eingabe aber später entfernt wird (z. B. von 3 auf 0 Zeilen) funktioniert das Makro nicht und es erscheint der Laufzeitfehler 1004 (im Makro wird dann die 7. Zeile : "With Target.MergeArea " gelb hinterlegt) Kann mir jemand das Makro so ändern, dass es auch in umgekehrter Reihenfolge funktioniert?
Wäre für Hilfe wirklich dankbar.
Ach ja, hier noch das Makro:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If Target.Row > 1 And Target.Row < 100 Then
If Target.MergeCells Then
With Target.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End If
Application.ScreenUpdating = True
End Sub

Schöne Grüße
Gesa S.

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro funktioniert nicht richtig
14.11.2006 23:35:21
fcs
Hallo Gesa,
ich hab mit dem Makro mal ein wenig experimentiert und Modifikationen eingebaut.
Die Anpassung der Zeilenhöhe beim völligen/teilweisen Löschen von Text in den verbundenen Zellen funktioniert.
Gruss
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RowHeightMin As Single
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
RowHeightMin = 10 ' Diesen Wert vergrößern, wenn eine Mindestzeilenhöhe nicht unterschritten werden soll
If Target.Row > 1 And Target.Row < 100 Then
If Target.MergeCells Then
With Target
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
.EntireRow.AutoFit
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Target
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(Application.WorksheetFunction.Max(CurrentRowHeight, RowHeightMin) > PossNewRowHeight, _
WorksheetFunction.Max(CurrentRowHeight, RowHeightMin), PossNewRowHeight)
End If
End With
End If
End If
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Makro funktioniert nicht richtig
15.11.2006 09:34:30
Gesa
Hallo Franz,
vorab erst mal ein großes Dankeschön.
Leider funktioniert es bei mir nicht (wenn ich Daten eingebe, werden die verbundenen Zellen wieder getrennt und die Zeilenhöhe wird nur "vergrößert").
Habe eine Beispieldatei (https://www.herber.de/bbs/user/38192.xls) beigefügt. Vielleicht ist es ja irgendwie ein Einstellungsfehler?
Schöne Grüße
Gesa S.
AW: Makro funktioniert nicht richtig
15.11.2006 15:24:05
fcs
Hallo Gesa,
ich hatte das Makro unter Excel97 auf meinem Rechner daheim erstellt. Unter Excel 2003 läuft es jetzt auch bei mir nicht korrekt.
Hab das Makro nochmals angepaßt, hoffe es läuft dann.
Allerdings muss ich zugeben, dass verbundene Zellen für mich eine der problematischsten Funktionen in Excel sind und ich sie aus verschiedene Gründen meide wie der Teufel das Weihwasser. Die Klimmzüge, die du hier für die Zeilenhöhe betreiben muss sind da nur ein Beispiel.
Gruß
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RowHeightMin As Single
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
RowHeightMin = 10 ' Diesen Wert vergrößern, wenn eine Mindestzeilenhöhe nicht unterschritten werden soll
If Target.Row > 1 And Target.Row < 100 Then
If Target.MergeCells Then
With Target.Range("A1").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
.EntireRow.AutoFit
CurrentRowHeight = Target.Range("A1").RowHeight
ActiveCellWidth = Target.Range("A1").ColumnWidth
For Each CurrCell In Target.Range("A1").MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(Application.WorksheetFunction.Max(CurrentRowHeight, RowHeightMin) > PossNewRowHeight, _
WorksheetFunction.Max(CurrentRowHeight, RowHeightMin), PossNewRowHeight)
End If
End With
End If
End If
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Makro funktioniert nicht richtig
15.11.2006 15:24:21
fcs
Hallo Gesa,
ich hatte das Makro unter Excel97 auf meinem Rechner daheim erstellt. Unter Excel 2003 läuft es jetzt auch bei mir nicht korrekt.
Hab das Makro nochmals angepaßt, hoffe es läuft dann.
Allerdings muss ich zugeben, dass verbundene Zellen für mich eine der problematischsten Funktionen in Excel sind und ich sie aus verschiedene Gründen meide wie der Teufel das Weihwasser. Die Klimmzüge, die du hier für die Zeilenhöhe betreiben muss sind da nur ein Beispiel.
Gruß
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RowHeightMin As Single
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
RowHeightMin = 10 ' Diesen Wert vergrößern, wenn eine Mindestzeilenhöhe nicht unterschritten werden soll
If Target.Row > 1 And Target.Row < 100 Then
If Target.MergeCells Then
With Target.Range("A1").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
.EntireRow.AutoFit
CurrentRowHeight = Target.Range("A1").RowHeight
ActiveCellWidth = Target.Range("A1").ColumnWidth
For Each CurrCell In Target.Range("A1").MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(Application.WorksheetFunction.Max(CurrentRowHeight, RowHeightMin) > PossNewRowHeight, _
WorksheetFunction.Max(CurrentRowHeight, RowHeightMin), PossNewRowHeight)
End If
End With
End If
End If
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Makro funktioniert nicht richtig
15.11.2006 15:42:23
Gesa
Hallo Franz,
funktioniert einwandfrei!
Vielen Dank und ein großes Kompliment :-)
Gesa S
AW: Makro funktioniert nicht richtig
15.11.2006 15:24:24
fcs
Hallo Gesa,
ich hatte das Makro unter Excel97 auf meinem Rechner daheim erstellt. Unter Excel 2003 läuft es jetzt auch bei mir nicht korrekt.
Hab das Makro nochmals angepaßt, hoffe es läuft dann.
Allerdings muss ich zugeben, dass verbundene Zellen für mich eine der problematischsten Funktionen in Excel sind und ich sie aus verschiedene Gründen meide wie der Teufel das Weihwasser. Die Klimmzüge, die du hier für die Zeilenhöhe betreiben muss sind da nur ein Beispiel.
Gruß
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RowHeightMin As Single
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
RowHeightMin = 10 ' Diesen Wert vergrößern, wenn eine Mindestzeilenhöhe nicht unterschritten werden soll
If Target.Row > 1 And Target.Row < 100 Then
If Target.MergeCells Then
With Target.Range("A1").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
.EntireRow.AutoFit
CurrentRowHeight = Target.Range("A1").RowHeight
ActiveCellWidth = Target.Range("A1").ColumnWidth
For Each CurrCell In Target.Range("A1").MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(Application.WorksheetFunction.Max(CurrentRowHeight, RowHeightMin) > PossNewRowHeight, _
WorksheetFunction.Max(CurrentRowHeight, RowHeightMin), PossNewRowHeight)
End If
End With
End If
End If
Application.ScreenUpdating = True
End Sub

Anzeige

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige