automaticaly adjust row size after expand of parent node (double click)?

[McGreger]

Dear Gurus,

i'm facing a problem in my report when expanding a parentnode by double clicking the column description.

This is my default report

When double clicking the node "IC Consolidation" the expand destroys the row height. even thought there are max 3 line see "Data entry individual Company".

as you can see the height is exceptionaly higher than the descriptions of the cells

When double clicking the rownumber at the left, excel adjusts the height properly (Standard Excel Feature).

Therefore my question. Is there a way to adjust the row size after the expand automaticaly. For example using VBA Macros?

I already read that there is no specific event for that case like "After_Expand".

The "After_Refresh" Event is not triggered when expanding the columns.

So you might have some advice or workaround for that problem.

Thanks in advance.

Kind Regards

Eric

[former_member186338 · Accepted solution]

Hi Eric,

Yes, no specific events!

You can try to use double click event in the area of column header:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

...

End Sub

And launch timer to perform formatting after some delay...

But the expansion time is not predictable

Theoretically in the timer procedure you can check if the column header is changed...

Vadim

[McGreger · Accepted solution]

Dear Vadim,

as always thank you for your fast reply, i will try your suggestion and see if the problem can be solved.

Kind regards Eric

[former_member186338 · Accepted solution]

I have checked - it will be a very complex code... And not sure that very stable

[former_member186338 · Accepted solution]

Code samples:

Worksheet module:

Option Explicit

Dim epm As New FPMXLClient.EPMAddInAutomation

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim lngRowHeader As Long

Dim wshCurrent As Worksheet

Dim rngColHeader As Range

Set wshCurrent = ThisWorkbook.ActiveSheet

lngRowHeader = 7

Set rngColHeader = wshCurrent.Range(wshCurrent.Cells(lngRowHeader, wshCurrent.Range(epm.GetDataTopLeftCell(wshCurrent, "000")).Column), _

    wshCurrent.Cells(lngRowHeader, wshCurrent.Range(epm.GetDataBottomRightCell(wshCurrent, "000")).Column))

If Not Intersect(Target, rngColHeader) Is Nothing Then

    'ThisWorkbook.ActiveSheet.Range("C1").Value = ThisWorkbook.ActiveSheet.Range("C1").Value + 1

    varColumHeaderArr = rngColHeader.Value

    lngTimerCounter = 0

    lngTimerID = SetTimer(0&, 0&, 100&, AddressOf TimerProc)

End If

Cancel = False

End Sub

General module:

Option Explicit

' Set WinAPI Timer

Public Declare Function SetTimer Lib "user32" ( _

    ByVal hwnd As Long, _

    ByVal nIDEvent As Long, _

    ByVal uElapse As Long, _

    ByVal lpTimerFunc As Long) As Long

' Kill WinAPI Timer

Public Declare Function KillTimer Lib "user32" ( _

    ByVal hwnd As Long, _

    ByVal nIDEvent As Long) As Long

' Global var for timer

Public lngTimerID As Long

Public lngTimerCounter As Long

Public varColumHeaderArr() As Variant

Public Sub DoubleClickHeader(Target As Range)

End Sub

Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)

    If nIDEvent = lngTimerID Then

        lngTimerCounter = lngTimerCounter + 1

        If lngTimerCounter > 10 Then

            lngTimerCounter = 0

            KillTimer 0&, lngTimerID

            ' Some code to test for changes here....

        End If

    End If

End Sub