Scrolling not working for TreeView

[walden]

Scrolling not working for TreeView

Hi
First of all, sorry for my bad english ...

I cannot get the scroll down or scroll up functionality to work for a tree view control in an userfom when performing a drag and drop operation on the tree. I am using excel 2010. I have attached the file which contains the code.
I try to solve this problem for several weeks... It is the only point which prevents me from finalizing my project, then I could thank never enough the person who will help me...
Thank you very much,
Friendly

[Aussiebear]

Sorry but your workbook is in french so am unable to assist, but have you had a look at Microsoft's TreeView.Scrollable Property

[walden]

Hello Aussiebear and Everyone
Thank you for your answer! Actually the file is in French... Do I have to try to translate it?
I have actually to look at the property, but unsuccessfully...
I begin to believe really that my request is not practicable...
Thank you again
Good day

[p45cal]

TreeView controls are not a thing I know a lot about, however your question gives me the opportunity to learn about them, and so I want to try and help, but it may not be fast! I can cope with a bit of French.
I have one question: Drag and drop from where?
edit, post asking that question: Is it a drag and drop operation within the tree that you're doing?

Some advice. Help others help you:
There's a significant amount of code in your workbook which raises 2 problems for helpers;
a) they have to trawl through the code and objects to find what you're talking about, so perhaps pointing them to which object and which parts of the code to look at would save them time and
b) opening a file from the internet with code in is a possible danger (there may be malicious code lurking, and it wouldn't be the first time I've found malicious code in an Excel file (unknown/not recognised as such by the person asking for help)) so anyone opening the file will first have to check for such unsafe code by disabling macros and looking through all the code. What you might be able to do here is remove code/userforms/sheets irrelevant to your question as much as possible without compromising the functionality relating to your question. I realise this is not especially easy - but you are the one asking for help, and you need to make it as easy as you reasonably can for others to help you.

I'm fairly sure the code you want looked at is relates to the TVClasNode control in the BDGestCode userform?
I see there is no event code for such things as OLECompleteDrag but it may not be relevant -I have yet to learn about it.
At the moment I'm still checking the code is safe and not going to do unexpected things to my computer/file system etc. I have 2000 lines of code in 10 modules to look through before I enable macros.

[walden]

Hello p45cal,
Thanks to you to interest you in my problem and of your advice! I understand of course the caution proof of which you make concerning attached files.
Actually, I owe more precise. My level of English is a handicap ...
Here are some explanations on my problem: my file contains a userform BDGestCode and I think that you should focus only on this userform!
This userform BDGestCode contains a treeview TVClasCode, which contains the feature to drag and drop. Everything works perfectly.
My problem appears when the treeview contains many knot and when a scrollbar is necessary.
In the case, during the drag and dropdrop kick, when I select an item and when I wish to move him towards a not visible knot in the screen, the scrollbar does not parade and motionless rest ...
I hope to have been clear, it is not easy to explain my concerns in English and thank you of your understanding.
THANK YOU AGAIN of your kind help,
Very friendly

[p45cal]

Could you make available on some file sharing site or zipped up here as an attachment the gif images in the \images folder. It just saves me making them up.

[walden]

Here is !
I have to specify that I did not design this file: the author is another guy (thank you very much to him)!

[p45cal]

Early days yet, but try this:

Private Sub TVClasCode_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
'Gestion de l'icône de la souris et des images du Treeview pendant un Drag & Drop
    With BDGestCode
        If Button = 1 Then
                Debug.Print x, y
            If Not .TVClasCode.HitTest(x * 15, y * 15) Is Nothing Then
                If ClefDrag Like "Cat*" Or .TVClasCode.HitTest(x * 15, y * 15).Key = "Cat0" Or Not BoolEnableDrag Then
                    .TVClasCode.MousePointer = ccNoDrop
                    BoolDrag = False
                Else
                    BoolDrag = True
                    If Shift = 2 Then
                        BoolCopy = True
                        .TVClasCode.Nodes(ClefDrag).Image = IIf(TypDrag = "G", 6, 7)
                    End If
                    .TVClasCode.MousePointer = ccCustom
                    .TVClasCode.MouseIcon = .TVClasCode.Nodes(ClefDrag).CreateDragImage
                End If
                Set .TVClasCode.DropHighlight = .TVClasCode.HitTest(x * 15, y * 15)
                If Not .TVClasCode.DropHighlight.Expanded Then .TVClasCode.DropHighlight.Expanded = True
                .TVClasCode.Nodes(Application.Min(.TVClasCode.DropHighlight.Index + 1, TVClasCode.Nodes.Count)).EnsureVisible
                .TVClasCode.Nodes(Application.Max(1, .TVClasCode.DropHighlight.Index - 1)).EnsureVisible
            End If
        Else
            Set .TVClasCode.DropHighlight = Nothing
            .TVClasCode.MousePointer = ccDefault
            Set .TVClasCode.MouseIcon = Nothing
            BoolDrag = False
        End If
    End With
End Sub

same code below but am able to highlight the added lines:


Private Sub TVClasCode_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
'Gestion de l'icône de la souris et des images du Treeview pendant un Drag & Drop
With BDGestCode
If Button = 1 Then
Debug.Print x, y
If Not .TVClasCode.HitTest(x * 15, y * 15) Is Nothing Then
If ClefDrag Like "Cat*" Or .TVClasCode.HitTest(x * 15, y * 15).Key = "Cat0" Or Not BoolEnableDrag Then
.TVClasCode.MousePointer = ccNoDrop
BoolDrag = False
Else
BoolDrag = True
If Shift = 2 Then
BoolCopy = True
.TVClasCode.Nodes(ClefDrag).Image = IIf(TypDrag = "G", 6, 7)
End If
.TVClasCode.MousePointer = ccCustom
.TVClasCode.MouseIcon = .TVClasCode.Nodes(ClefDrag).CreateDragImage
End If
Set .TVClasCode.DropHighlight = .TVClasCode.HitTest(x * 15, y * 15)
If Not .TVClasCode.DropHighlight.Expanded Then .TVClasCode.DropHighlight.Expanded = True
.TVClasCode.Nodes(Application.Min(.TVClasCode.DropHighlight.Index + 1, TVClasCode.Nodes.Count)).EnsureVisible
.TVClasCode.Nodes(Application.Max(1, .TVClasCode.DropHighlight.Index - 1)).EnsureVisible
End If
Else
Set .TVClasCode.DropHighlight = Nothing
.TVClasCode.MousePointer = ccDefault
Set .TVClasCode.MouseIcon = Nothing
BoolDrag = False
End If
End With
End Sub

[walden]

Hello p45cal, everyone,
Oh how I can thank you?!?!
It is the solution which I looked for for weeks!! THANK YOU SO MUCH!
Thank you also for your patience and for your understanding...
Sorry for grammatical mistakes in English,
Friendly