Új hozzászólás Aktív témák

• #50365 TillaT tag TheSaint #50363

  Új Válasz 2023-01-31 18:40:29 #50365

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  TillaT

  tag

  válasz TheSaint #50363 üzenetére

  Köszönöm. Kicsit más úton, a Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) -el próbálkoztam, és eddig úgy tűnik, hogy jól működik. Azonnal reagál az aktív munkalapon a változásokra. Mindegy, hogy beszúrok vagy törlök sorokat, oszlopokat.

  Arra még nem sikerült rájönnöm, hogy a kód hatása alatt miért nem engedi a sorok és/vagy oszlopok kijelölésével az egész sorok/oszlopok beszúrását/törlését; hogy miért csak a táblázaton belüli cellák kijelölésével enged beszúrni és törölni egész sorokat/oszlopokat, ... de ez a működés szempontjából kevésbé zavaró, mint ami az alap problémám volt.

  Még egyszer köszönöm a segítséget és az együttgondolkodást.

  Dim lastRow As Long
Dim lastColumn As Long
Dim scrollArea As Range
Dim ActiveSheetNumber As Integer

  Private Sub Workbook_Open()
   ThisWorkbook.Sheets(1).Activate
   Call ScrollAreaInterpret
End Sub

  Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call ScrollAreaInterpret
End Sub

  Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
        Call ActSheetChange
    End If
    Call ScrollAreaInterpret
End Sub

  Sub ScrollAreaInterpret()
        lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
      lastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
      Set scrollArea = ActiveSheet.Range("A1").Resize(lastRow, lastColumn)
        ActiveSheet.scrollArea = scrollArea.Address
End Sub
       
Sub ActSheetChange()
    ActiveSheetNumber = ActiveSheet.Index
    ThisWorkbook.Sheets(ActiveSheetNumber + 1).Activate
    ThisWorkbook.Sheets(ActiveSheetNumber).Activate
End Sub

Új hozzászólás Aktív témák