Workbook_SheetCalculate + 0effnen neue Datei

Guten Tag
Mit untenstehendem Code wird die Zeilenhöhe eines verbundenen Zellbereiches innerhalb der Datei "Beispiel" gesteuert. Ursprünglich stand am Anfang nicht "ThisWorkbook.Activate" - doch wenn ich eine neue Datei geöffnet habe, blieb der Code hängen, weil der neue Workbook aktiv war (und dann der Range("Beurteilung") nicht vorhanden war). Das ist nun nicht mehr der Fall.
Das Problem ist, dass nun beim Oeffnen eines neuen Workbooks gleich wieder in die Datei "Beispiel" gewechselt wird.
Wie löse ich das Problem, dass nicht immer wieder die Datei "Beispiel" angesprungen wird, wenn ich eine neue Datei öffne?
Danke für eine Antwort.
Gruss, Peter


Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ThisWorkbook.Activate
With Application
.ScreenUpdating = False
With Range("Beurteilung")
If Len(.Value)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim Tabelle As String Dim Zelle As String Zelle = Replace(ThisWorkbook.Names(1).RefersToLocal, "=", "") Tabelle = Left$(Zelle, InStr(Zelle, "!") - 1) Zelle = Replace(Zelle, Tabelle & "!", "") If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub With Application .ScreenUpdating = False With ThisWorkbook.Sheets(Tabelle).Range(Zelle) If Len(.Value) < 200 Then .RowHeight = 27.75 Else .RowHeight = 42 End If End With .ScreenUpdating = True End With End Sub

Hallo Tino
Vielen Dank.
Ich habe in der Zwischenzeit den eigentlichen Code in ein Modul verlegt und rufe von den zwei betroffenen Tabellen diesen auf. Da ich zum Teil 6 verschiedene Zeilenhöhen brauche, habe ich auf Select Case umgestellt. Allerdings funktioniert das nicht und ich verstehe auch nicht weshalb. Deshalb versuchte im Code einen Haltepunkt zu setzen, doch da passiert gar nichts.
Kann ich hier nicht mit Select Case arbeiten - oder was ist da schief?
Danke für eine Rückmeldung.
Gruss, Peter
Option Explicit


Private Sub SheetCalculate(ByVal Sh As Object)
Call Zeilen_adjustieren
End Sub

Option Explicit


Private Sub Zeilen_adjustieren()
ThisWorkbook.Activate
With Application
'.ScreenUpdating = False
With Range("BeurteilungE")
Select Case Len(.Value)
Case Is > 200
.RowHeight = 42
Case Is > 60
.RowHeight = 27.75
Case Else
.RowHeight = 14.25
End Select
End With
With Range("BeurteilungO")
Select Case Len(.Value)
Case Is > 200
.RowHeight = 42
Case Is > 60
.RowHeight = 27.75
Case Else
.RowHeight = 14.25
End Select
End With
'   .ScreenUpdating = True
End With
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim rg As Range Dim A As Integer With Application .ScreenUpdating = False For A = 1 To 6 Set rg = ThisWorkbook.Names("Beurteilung" & A).RefersToRange With rg If Len(.Value) < 200 Then .RowHeight = 27.75 Else .RowHeight = 42 End If End With Next A .ScreenUpdating = True End With End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim rg As Range Dim A As Integer Dim iHeKl As Integer, iHeGr As Integer With Application .ScreenUpdating = False For A = 1 To 6 Set rg = ThisWorkbook.Names("Beurteilung" & A).RefersToRange Select Case A Case 1: iHeKl = 27.5: iHeGr = 42 Case 2: iHeKl = 28.5: iHeGr = 43 Case 3: iHeKl = 29.5: iHeGr = 44 Case 4: iHeKl = 30.5: iHeGr = 45 Case 5: iHeKl = 31.5: iHeGr = 46 Case Else: iHeKl = 32.5: iHeGr = 47 End Select With rg If Len(.Value) < 200 Then .RowHeight = iHeKl Else .RowHeight = iHeGr End If End With Next A .ScreenUpdating = True End With End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim rg As Range Dim A As Integer Dim sngHe As Single With Application .ScreenUpdating = False For A = 1 To 6 Set rg = ThisWorkbook.Names("Beurteilung" & A).RefersToRange With rg Select Case Len(.Value) Case Is < 10: sngHe = 15 Case Is < 20: sngHe = 20 Case Is < 50: sngHe = 22 Case Is < 150: sngHe = 30 Case Is < 175: sngHe = 35 Case Else:: sngHe = 42 End Select .RowHeight = sngHe End With Next A .ScreenUpdating = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Workbook_SheetCalculate + 0effnen neue Datei

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread