UN GRAPHIQUE 3D TOUT EN MOUVEMENT graphique 3D, evenements, vba excel, classe, getkeystate, Source N°47595

Information sur la source

Catégorie :VBA Classé sous : graphique 3D, evenements, vba excel, classe, getkeystate Niveau : Initié Date de création : 14/08/2008 Date de mise à jour : 22/10/2008 23:08:12 Vu / téléchargé: 7 206 / 654

Auteur : bigfish_le vrai

Ecrire un message privé

Note :

9,00 / 10

1
2
3
4
5
6
7
8
9
10

Commentaire sur cette source (10)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Voici une source(fichier excel) pour epater les collegues de boulot.
Ce graphique 3D peut etre deplace en rotation et en elevation de façon dynamique. Un peu comme un objet 3D dans un espace 3D. Pour cela il suffit de :

- Selectionner le graphique par un simple clic.
- Puis tout en maintenant l'une des 2 touches [Shift] enfoncee, cliquer sur le graphique et deplacer votre souris dans n'importe quelle direction.
- Enfin pour valider la position relecher la touche [Shift].

Cela ne sert pas a grand chose si ce n'est de donner un exemple d'utilisation des evenements de la classe graphique d'excel. Car comme vous le savez deja, les graphiques dans une feuille excel non pas d'evenement associe.

Source

Dans l'objet Thisworkbook
'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :13-08-2008
'V2.3
'
'
'
'Permet de Remplir ou vider les modules de classe a l'ouverture
'ou lors des changements de feuille
Option Explicit
Dim Feuille As Worksheet
Private Sub Workbook_Open()
Set Feuille = Worksheets("Graph 3D")
Set XlAppli.XL = Excel.Application
Call XlAppli.InitClass(Feuille)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call XlAppli.InitClass(Sh)
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Call XlAppli.EmptyClass(Sh)
End Sub
---------------------------------------------------------------------------
---------------------------------------------------------------------------
Dans le module1 :
'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :15-08-2008
'V2.6
'
Option Explicit
Public XlAppli As New ClasseAppli
---------------------------------------------------------------------------
---------------------------------------------------------------------------
Dans le module de classe ClasseAppli :
'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :13-08-2008
'V2.3
'
Option Explicit
Public WithEvents XL As Excel.Application
Dim ClTabChart() As ClasseChart
'Permet de vider la classe
Public Sub EmptyClass(ByVal Feuille As Object)
Dim j As Integer
On Error Resume Next
For j = 1 To UBound(ClTabChart)
Set ClTabChart(j).Graph = Nothing
Next
End Sub
'remplissage de la classe
Public Sub InitClass(ByVal Feuille As Object)
Dim i As Integer
'on verifi que c'est bien une feuille
If TypeOf Feuille Is Worksheet Then
'on regarde si il y a des graphique dans la feuille
If Feuille.ChartObjects.Count = 0 Then Exit Sub
'S'il y a bien un ou plusieurs graphiques,
'on les injectes dans le module de classe
ReDim Preserve ClTabChart(Feuille.ChartObjects.Count)
For i = 1 To Feuille.ChartObjects.Count
Set ClTabChart(i) = New ClasseChart
Set ClTabChart(i).Graph = Feuille.ChartObjects(i).Chart
Set ClTabChart(i).ParentSheet = Feuille
Next i
End If
End Sub
---------------------------------------------------------------------------
---------------------------------------------------------------------------
Dans le module de classe ClasseChart :
'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :29-09-2008
'V2.7
'Merci à PCPT(VBFRANCE) pour les corrections
'
Option Explicit
'permet de recuperer la position en x,y du pointeur de souris
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim PositionCursor As POINTAPI
'permet de detecter l'etat des touches du clavier
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_LSHIFT As Long = &HA0 'touche shift de Gauche
Private Const VK_RSHIFT As Long = &HA1 'touche shift de Droite
Private Const MaxAngle As Integer = 360 'valeur limite maxi en rotation
Private Const MaxElevation As Integer = 90 'valeur limite maxi en elevation
Dim KeyTest As Boolean, AngleRotation As Integer, GraphElevation As Integer
Dim CursorOrigineX As Integer, CursorOrigineY As Integer, GraphOrigineX As Integer, GraphOrigineY As Integer
Public ParentSheet As Worksheet
Public WithEvents Graph As Chart
Private Sub Graph_BeforeRightClick(Cancel As Boolean)
' desactive le menu contextuel du graphique qui apparait lors d'un clic droit
' ici il sera desactive si la touche shift est enfoncee
If ShiftKeyStat() = True Then Cancel = True
End Sub
'ici on detecte un clic droit ou gauche dans le graphique
Private Sub Graph_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
'si clic il y a :
Call GraphMotion
End Sub
Private Function ShiftKeyStat() As Boolean
'permet de détecter si les touches shift de droite ou de gauche sont enfoncees
ShiftKeyStat = False 'remise a false avant vérif.
If GetKeyState(VK_LSHIFT) < 0 Or GetKeyState(VK_RSHIFT) < 0 Then ShiftKeyStat = True
End Function
' ---------------------------------------------
' ce code est appele si un clic sur le graph a ete detecte par
' l'evenement Mouse_down de la classe Classechart
' ce code permet :
' - de lancer le déplacement du graphique si la touche shift est
' enfoncé lors du clic.
' - de calculer les valeurs de déplacement.
' ----------------------------------------------
Private Sub GraphMotion()
Dim NomGraph As String, NbRotationX As Long
NbRotationX = 0
' Dans le cas d'un deuxieme passage on passe cette variable a false
' pour stopper la boucle do loop
If KeyTest = True Then KeyTest = False '***donc si false on fait rien? donc on met false de toute manière...
' ben en faite tous s'arretera à la boucle do/loop... ouai ce n'est peut etre pas tres propre...
' un exit sub aurai pu faire l'affaire mais je le sent pas car cela n'arreterait pas
' l'eventuelle premiere boucle en cours... ou alors associé au false pourquoi pas, mais rajouter
' une ligne exit sub alors que le false ce suffit à lui meme... J'sais pô !
'si une des touches shift est enfoncée on demarre le deplacement
If ShiftKeyStat() = True Then
'cette variable vas nous permetre de sortir de la boucle
KeyTest = ShiftKeyStat()
'on recupere le nom du graphique activé
'NomGraph = Right(ActiveChart.Name, Len(ActiveChart.Name) - Len(ActiveSheet.Name) - 1)
NomGraph = Right$(Me.Graph.Name, Len(Me.Graph.Name) - Len(Me.ParentSheet.Name) - 1)
'ici ce trouve toute la subtilite qui permet le deplacement
' sans clignotement du graphique :
'pour demarrer nous avions besoin que le graphique soit activé
'et dans ce cas c'est lui qui a le focus. Ors, dans cette situation,
'lors du déplacement du pointeur de souris et a cause de la fonction
'GetCursorPos, le focus vas alterner entre la fenetre principale d'excel
'et le graphique ce qui provoquera le clignotement.
'Mais on ne peut hélas pas travailler sur un graphique qui n'est pas
'au minimum sélectionne.
'Donc l'astuce consiste simplement a sélectionner une cellule pour
'desactiver le graphique et donc lui enlever le focus, puis a le
'selectionner tout de suite apres. La subtilite est qu'un graphique
'selectionne n'a pas le focus a contrario d'un graphique active. ouf!...
Me.ParentSheet.[A1].Select
Me.ParentSheet.ChartObjects(NomGraph).Select
'on recupere toutes les positions d'origines
GraphOrigineX = ActiveChart.Rotation 'angle actuel du graph
GraphOrigineY = ActiveChart.Elevation 'elevation actuelle du graph
GetCursorPos PositionCursor 'on recupere la position X,Y du pointeur de souris
CursorOrigineX = PositionCursor.x
CursorOrigineY = PositionCursor.y
'on a le clic... la touche [shift] est enfoncee alors on y va...
Do Until KeyTest = False
' si la touche shift est relachee on sort de la boucle en changeant l'etat de la variable KeyTest
If ShiftKeyStat() = False Then KeyTest = False
'le deplacement ce fait par l'incementation positive ou negative des valeurs d'origines de position du graphique.
'l'incrementation ce fait a partir d'un point 0 qui est le point du clique souris
'
'on recupere la position X,Y du poiteur de souris
GetCursorPos PositionCursor
'calcul de l'angle de rotation a partir de l'angle d'origine et de la position d'origine du clique
'+ prise en compte de la valeur de zoom
AngleRotation = GraphOrigineX + (CursorOrigineX - PositionCursor.x) * (1 + (ActiveWindow.Zoom / 100))
'calcul de l'elevation a partir de l'elevation d'origine et de la position d'origine du clique
'+ prise en compte de la valeur de zoom
GraphElevation = GraphOrigineY - (CursorOrigineY - PositionCursor.y) * (1 + (ActiveWindow.Zoom / 100))
'ici on autorise le multi tour sur laxe X
If AngleRotation > MaxAngle Then 'Deplacement du pointeur a gauche du clique
NbRotationX = Int(AngleRotation / MaxAngle)
AngleRotation = AngleRotation - (MaxAngle * NbRotationX)
End If
If AngleRotation < 0 Then 'Deplacement du pointeur a Droite du clique
'pour comprendre la suite n'oubliez pas que sur un cercle 360 est equivalent a 0
'ce qui permet d'eviter la division par 0
NbRotationX = Int(AngleRotation / MaxAngle)
AngleRotation = AngleRotation - (MaxAngle * NbRotationX)
End If
'limitation des valeurs au maxi et mini acceptable
' pour l'axe Y(Elevation)
If GraphElevation > MaxElevation Then
GraphElevation = MaxElevation
End If
If GraphElevation < 0 Then GraphElevation = 0
'Remplacez la ligne precedente par la suivante pour montrer le dessous du graphique
'If GraphElevation < -90 Then GraphElevation = -90
'en cas de depassement(run-time error 9) on gere par
'une sortie de la boucle(le parachute)
On Error Resume Next
Me.Graph.Rotation = AngleRotation
Me.Graph.Elevation = GraphElevation
If Err > 0 Then Exit Do
DoEvents
With Me.ParentSheet
.[u10].Value = (CursorOrigineX - PositionCursor.x)
.[u11].Value = AngleRotation
.[u12].Value = GraphOrigineX
.[u14].Value = (CursorOrigineY - PositionCursor.y)
.[u15].Value = GraphElevation
.[u16].Value = GraphOrigineY
End With
Loop
If Err = 0 Then
Me.Graph.Rotation = AngleRotation
Me.Graph.Elevation = GraphElevation
Else
Err.Clear
End If
Me.ParentSheet.ChartObjects(NomGraph).Activate
End If
End Sub

Dans l'objet Thisworkbook

'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :13-08-2008
'V2.3
'
'
'
'Permet de Remplir ou vider les modules de classe a l'ouverture
'ou lors des changements de feuille

Option Explicit

Dim Feuille As Worksheet

Private Sub Workbook_Open()
    Set Feuille = Worksheets("Graph 3D")
    Set XlAppli.XL = Excel.Application
    Call XlAppli.InitClass(Feuille)
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call XlAppli.InitClass(Sh)
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Call XlAppli.EmptyClass(Sh)
End Sub
---------------------------------------------------------------------------

---------------------------------------------------------------------------
Dans le module1 :

'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :15-08-2008
'V2.6
'
Option Explicit

Public XlAppli As New ClasseAppli
---------------------------------------------------------------------------

---------------------------------------------------------------------------
Dans le module de classe ClasseAppli :

'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :13-08-2008
'V2.3
'
Option Explicit

Public WithEvents XL As Excel.Application
Dim ClTabChart() As ClasseChart


'Permet de vider la classe
Public Sub EmptyClass(ByVal Feuille As Object)
    Dim j As Integer
    On Error Resume Next
    For j = 1 To UBound(ClTabChart)
        Set ClTabChart(j).Graph = Nothing
    Next
End Sub
 'remplissage de la classe
Public Sub InitClass(ByVal Feuille As Object)
    Dim i As Integer
    'on verifi que c'est bien une feuille
    If TypeOf Feuille Is Worksheet Then
        'on regarde si il y a des graphique dans la feuille
        If Feuille.ChartObjects.Count = 0 Then Exit Sub
        'S'il y a bien un ou plusieurs graphiques,
        'on les injectes dans le module de classe
        ReDim Preserve ClTabChart(Feuille.ChartObjects.Count)
        For i = 1 To Feuille.ChartObjects.Count
            Set ClTabChart(i) = New ClasseChart
            Set ClTabChart(i).Graph = Feuille.ChartObjects(i).Chart
            Set ClTabChart(i).ParentSheet = Feuille
        Next i
    End If
End Sub
---------------------------------------------------------------------------

---------------------------------------------------------------------------
Dans le module de classe ClasseChart :

'Macro Creee par : BigFish_le Vrai (Philippe E)
'le :29-09-2008
'V2.7
'Merci à PCPT(VBFRANCE) pour les corrections
'
Option Explicit

'permet de recuperer la position en x,y du pointeur de souris
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Dim PositionCursor As POINTAPI

'permet de detecter l'etat des touches du clavier
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_LSHIFT As Long = &HA0 'touche shift de Gauche
Private Const VK_RSHIFT As Long = &HA1 'touche shift de Droite

Private Const MaxAngle As Integer = 360 'valeur limite maxi en rotation
Private Const MaxElevation As Integer = 90 'valeur limite maxi en elevation

Dim KeyTest As Boolean, AngleRotation As Integer, GraphElevation As Integer
Dim CursorOrigineX As Integer, CursorOrigineY As Integer, GraphOrigineX As Integer, GraphOrigineY As Integer

Public ParentSheet As Worksheet
Public WithEvents Graph As Chart

Private Sub Graph_BeforeRightClick(Cancel As Boolean)
    ' desactive le menu contextuel du graphique qui apparait lors d'un clic droit
    ' ici il sera desactive si la touche shift est enfoncee
    If ShiftKeyStat() = True Then Cancel = True
End Sub

'ici on detecte un clic droit ou gauche dans le graphique
Private Sub Graph_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    'si clic il y a :
    Call GraphMotion
End Sub

Private Function ShiftKeyStat() As Boolean
    'permet de détecter si les touches shift de droite ou de gauche sont enfoncees
    ShiftKeyStat = False 'remise a false avant vérif.
    If GetKeyState(VK_LSHIFT) < 0 Or GetKeyState(VK_RSHIFT) < 0 Then ShiftKeyStat = True
End Function

' ---------------------------------------------
' ce code est appele si un clic sur le graph a ete detecte par
' l'evenement Mouse_down de la classe Classechart
' ce code permet :
' - de lancer le déplacement du graphique si la touche shift est
'   enfoncé lors du clic.
' - de calculer les valeurs de déplacement.
' ----------------------------------------------
Private Sub GraphMotion()

    Dim NomGraph As String, NbRotationX As Long
    
    NbRotationX = 0

    ' Dans le cas d'un deuxieme passage on passe cette variable a false
    ' pour stopper la boucle do loop
    If KeyTest = True Then KeyTest = False '***donc si false on fait rien? donc on met false de toute manière...
    ' ben en faite tous s'arretera à la boucle do/loop... ouai ce n'est peut etre pas tres propre...
    ' un exit sub aurai pu faire l'affaire mais je le sent pas car cela n'arreterait pas
    ' l'eventuelle premiere boucle en cours... ou alors associé au false pourquoi pas, mais rajouter
    ' une ligne exit sub alors que le false ce suffit à lui meme... J'sais pô !
    
    'si une des touches shift est enfoncée on demarre le deplacement
    If ShiftKeyStat() = True Then
        'cette variable vas nous permetre de sortir de la boucle
        KeyTest = ShiftKeyStat()
        'on recupere le nom du graphique activé
        'NomGraph = Right(ActiveChart.Name, Len(ActiveChart.Name) - Len(ActiveSheet.Name) - 1)
        NomGraph = Right$(Me.Graph.Name, Len(Me.Graph.Name) - Len(Me.ParentSheet.Name) - 1)
        
        'ici ce trouve toute la subtilite qui permet le deplacement
        '  sans clignotement du graphique :
        'pour demarrer nous avions besoin que le graphique soit activé
        'et dans ce cas c'est lui qui a le focus. Ors, dans cette situation,
        'lors du déplacement du pointeur de souris et a cause de la fonction
        'GetCursorPos, le focus vas alterner entre la fenetre principale d'excel
        'et le graphique ce qui provoquera le clignotement.
        'Mais on ne peut hélas pas travailler sur un graphique qui n'est pas
        'au minimum sélectionne.
        'Donc l'astuce consiste simplement a sélectionner une cellule pour
        'desactiver le graphique et donc lui enlever le focus, puis a le
        'selectionner tout de suite apres. La subtilite est qu'un graphique
        'selectionne n'a pas le focus a contrario d'un graphique active. ouf!...
        Me.ParentSheet.[A1].Select
        Me.ParentSheet.ChartObjects(NomGraph).Select
        
        'on recupere toutes les positions d'origines
        GraphOrigineX = ActiveChart.Rotation 'angle actuel du graph
        GraphOrigineY = ActiveChart.Elevation 'elevation actuelle du graph
        GetCursorPos PositionCursor 'on recupere la position X,Y du pointeur de souris
        CursorOrigineX = PositionCursor.x
        CursorOrigineY = PositionCursor.y
        
        'on a le clic... la touche [shift] est enfoncee alors on y va...
        Do Until KeyTest = False
            ' si la touche shift est relachee on sort de la boucle en changeant l'etat de la variable KeyTest
            If ShiftKeyStat() = False Then KeyTest = False

            'le deplacement ce fait par l'incementation positive ou negative des valeurs d'origines de position du graphique.
            'l'incrementation ce fait a partir d'un point 0 qui est le point du clique souris
            '
            'on recupere la position X,Y du poiteur de souris
            GetCursorPos PositionCursor
            'calcul de l'angle de rotation a partir de l'angle d'origine et de la position d'origine du clique
            '+ prise en compte de la valeur de zoom
            AngleRotation = GraphOrigineX + (CursorOrigineX - PositionCursor.x) * (1 + (ActiveWindow.Zoom / 100))
            'calcul de l'elevation a partir de l'elevation d'origine et de la position d'origine du clique
            '+ prise en compte de la valeur de zoom
            GraphElevation = GraphOrigineY - (CursorOrigineY - PositionCursor.y) * (1 + (ActiveWindow.Zoom / 100))
            
            'ici on autorise le multi tour sur laxe X
            If AngleRotation > MaxAngle Then 'Deplacement du pointeur a gauche du clique
                NbRotationX = Int(AngleRotation / MaxAngle)
                AngleRotation = AngleRotation - (MaxAngle * NbRotationX)
            End If
            If AngleRotation < 0 Then 'Deplacement du pointeur a Droite du clique
                'pour comprendre la suite n'oubliez pas que sur un cercle 360 est equivalent a 0
                'ce qui permet d'eviter la division par 0
                NbRotationX = Int(AngleRotation / MaxAngle)
                AngleRotation = AngleRotation - (MaxAngle * NbRotationX)
            End If
            
            'limitation des valeurs au maxi et mini acceptable
            ' pour l'axe Y(Elevation)
            If GraphElevation > MaxElevation Then
                GraphElevation = MaxElevation
            End If
            If GraphElevation < 0 Then GraphElevation = 0
            'Remplacez la ligne precedente par la suivante pour montrer le dessous du graphique
            'If GraphElevation < -90 Then GraphElevation = -90
            
            'en cas de depassement(run-time error 9) on gere par
            'une sortie de la boucle(le parachute)
            On Error Resume Next
            Me.Graph.Rotation = AngleRotation
            Me.Graph.Elevation = GraphElevation
            If Err > 0 Then Exit Do
            
            DoEvents
            With Me.ParentSheet
                .[u10].Value = (CursorOrigineX - PositionCursor.x)
                .[u11].Value = AngleRotation
                .[u12].Value = GraphOrigineX
                .[u14].Value = (CursorOrigineY - PositionCursor.y)
                .[u15].Value = GraphElevation
                .[u16].Value = GraphOrigineY
            End With
        Loop
        If Err = 0 Then
            Me.Graph.Rotation = AngleRotation
            Me.Graph.Elevation = GraphElevation
        Else
            Err.Clear
        End If
        Me.ParentSheet.ChartObjects(NomGraph).Activate
    End If
End Sub

Conclusion

Cela n'a pas ete simple car c'est la premiere fois que je mets le nez dans les classes. J'ai donc certainement fait quelques erreurs. N'hesiter pas a me les signaler

Merci a SilkyRoad pour son tutorial sur les evenements dans les graphiques.
Tutorial que vous pouvez retrouver ici : http://silkyroad.developpez.com/VBA/EvenementsGraphiques/

Merci a PCPT pour les corrections. Corrections qui permettent a cette source d'etre un vrai bon exemple d'utilisation de classe.

Amicalement

3ddI7IHd

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Graphique3D V2.7.xls147 456 octets

Télécharger le zip

Historique

14 août 2008 00:44:13 :: Correction de l'orthographe
14 août 2008 21:24:08 :: Suite au remarque de PCPT : Amelioration du calcul des valeurs de positions angulaire et elevation. Deplacement des calculs de la classe classchart vers le module module1. Correction de l'orthographe.
15 août 2008 18:22:28 :: Application des corrections proposées par PCPT
15 août 2008 18:50:33 :: Encore une correction d'orthograph...
15 août 2008 18:56:22 :: La nouvelle capture n'est pas passée lors de la derniere modif. Donc nouvelle tentative
29 septembre 2008 16:50:47 :: - Calcul des deplacements avec prise en compte de la valeur de zoom de la feuille excel - plus de limitation en rotation ce qui permet le multi tours
22 octobre 2008 23:08:12 :: Correction de l'orthographe (pour rester coherant avec ma config americaine et mon clavier QWERTY j'ai enleve les accents)

Sources du même auteur

ASTUCE POUR AMELIORER LA SECURITÉ D'ACCÉS AUX DONNÉES ET AU ...

UN COLOR PICKER SANS API ET UNIQUEMENT PAR CALCUL

TUER UNE/DES SESSION(S) CACHÉE(S) D'EXCEL À PARTIR D'UNE AUT...

SUBSTITUTION AU CONTROLE REFEDIT D'EXCEL

RECUPERER DES INFOS OU LES DONNÉES D'UN GRAPHIQUE SANS UTILI...

Toutes les sources de bigfish_le vrai

Sources de la même categorie

VBA EXCEL, REMPLISSAGE D'UN COMBOBOX OU D'UNE LISTBOX par Joh76

VBA EXCEL FONCTION POUR DÉTERMINER LA DERNIÈRE LIGNE D'UNE C... par Joh76

ASTUCES POUR EXCEL. par piloulac

FONCTION JOURSFÉRIÉS (FIXES ET MOBILES) JUSQU'EN 2030 UTILIS... par nerim

PLANNING POUR AGENT (PROJET) par p_l_b_nantes

Toutes les sources de la catégorie VBA

Sources en rapport avec celle ci

ASTUCE POUR AMELIORER LA SECURITÉ D'ACCÉS AUX DONNÉES ET AU ... par bigfish_le vrai

BOITE COULEURS par Le Pivert

STÉGANOGRAPHIE CRYPTÉE AVEC VIGENERE par Papymuzo

LISTER OUTLOOK À PARTIR D'EXCEL par Le Pivert

TABLES DE MULTIPLICATION par Le Pivert

Commentaires et avis

Commentaire de ghuysmans99 le 14/08/2008 00:59:20 10/10

Sublime !
Et le code est tout ce qu'il y a de clair, en plus !

Commentaire de PCPT le 14/08/2008 01:06:39 administrateur CS 8/10

outch c'est buggé mais y'a quelquechose à creuser :p

pourquoi buggé?
la rotation ne correspond pas réellement à l'orientation de la souris, mes premiers mouvements (sous excel2000) n'ont produit qu'un zoom
il a fallu au moins 7 8 tentatives pour réussir à faire tourner, mais pas régulier non plus. et pour cause il n'y a pas d'évaluation de distance entre le centre du graph et la distance de la souris (donc pas d'axe de rotation)

aussi, des poignées rouges apparaissent. en les sélectionnant on peut aussi tourner menant vers une sorte de wireframe, même sans shift. pas gênant, juste pour info.

quelques fautes de grammaire également

bref il y a encore de quoi faire mais c'est un très bon début, c'est visuellement attirant et assez novateur

un 8 d'encouragement ;)
++

Commentaire de bigfish_le vrai le 14/08/2008 03:40:57

Salut,

Merci ghuysmans99 !

PCPT: Oui en faite j'ai fait 2 grosses erreurs en postant: la 1ere est de ne pas avoir précisé que ce n'est pas fini. La 2eme erreur est de ne pas avoir expliqué pourquoi ce n'est pas fini.
En faite comme tu le sais et contrairement a la fonction GetCursorPos, excel donne des valeurs de position des objets, qui ce trouvent dans une feuille, non pas depuis le point haut gauche de l'écran, mais depuis le points haut gauche de la feuille. De faite je dois tenir compte de la hauteur de la barre de menu d'excel. Mon problème est de trouver sa hauteur.
Le ou les problème(s) que tu rencontres lors de l'utilisation de ce code doit être du a cela car j'ai en attendant de trouver une solution, mis des valeurs fixes. C'est valeur sont 25 en x et 110 en y. Evidemment elle sont approximative.

Donc promis je vais revoir tout ça, ainsi que les fautes de grammaire.

Et merci pour ton encouragement

A+:)

Commentaire de PCPT le 14/08/2008 07:17:03 administrateur CS

110 t'avais le temps, j'ai aussi une barre en haut :)

peut-être récupérer le handle du graphe au mouse_down avec l'API GetFocus, puis convertir la position avec ClientToScreen

et niveau "codage de la class" (donc objet), ce n'est pas encore çà ^^.
là tu perds l'avantage de la classe, il faudrait attacher ton graph, ce n'est pas à ta classe d'aller vérifier le document actif

++ ;)

Commentaire de bigfish_le vrai le 14/08/2008 21:44:21

Salut PCPT,

bon en faite la solution était très simple. J'ai même honte de ne pas l'avoir vu avant.:{
Il suffisait de considérer le clique comme le point zéro puis d'incrémenter les positions d'origines du graphique(avant le clique) avec les valeurs de déplacement du pointeur. Ces valeurs de déplacement sont calculées à partir du point 0(point du clique souris).

J'ai essayé sur 4 pc, sans aucun pb détecté mais hélas je n'ai pas le moyen d'essayer avec excel2000.

Concernant le codage de la classe ce n'est pas très clair encore. Pourrais-tu préciser: il faudrait attacher ton graph, ce n'est pas à ta classe d'aller vérifier le document actif

A+:)

Commentaire de dawee le 11/09/2008 10:05:18

Bonjour a tous, je me lance a poser une question, meme si avec mon niveau de competence je suis quasi-convaincu qu'elle sera hors-sujet et/ou ridicule...
Peut-on remplacer ce graphique par un graphique 3d cree a partir d'un tableau excel, par exemple un chart "surface" ?
Desole si cette question est hors de propos, merci neanmoins.

Commentaire de bigfish_le vrai le 11/09/2008 15:13:49

DAWEE : Non c'est une tres bonne question et la reponse est OUI !
Je suis meme en train de travailler sur le sujet. Pour faire l'essai c'est tres s'imple il te suffit de faire un clic droit dans le graphique et de choisir Graph type(type de graphique) et de choisir le graphique surfacique.
En suite tu cliques droit sur le sol(plancher) du graphique et tu ne lui mets pas de couleur ce qui aura pour effet de le faire disparaitre. Puis dans le code du module ClasseChart tu remplaces :

If GraphElevation < 0 Then GraphElevation = 0

par

If GraphElevation < -90 Then GraphElevation = -90

ce qui te permetra de le voir par dessous.

Amese toi bien^^

A+

Commentaire de dawee le 12/09/2008 04:45:01

Salut, merci pour ta reponse!
En fait, j'ai reussi a inserer un graphique 3d surfacique 'en force' apres l'avoir cree dans un autre fichier. J'ai fait un copier coller a l'ancienne a la place de ton graphique et ca fonctionne... Je dois simplement pas forcer sur la resolution de ma surface pour le temps de calcul, mais pour le show-off c'est effectivement assez impressionnant.
Je vais parcourir le code et essayer de comprendre, merci de le commenter autant en detail et de repondre si vite, bonne journee ! [non je suis pas nocturne, je suis en chine ;) ]

Commentaire de pat50m le 22/10/2008 21:58:38

Bonjour,
Merci de corriger les fautes d'orthographe :

Cela n'a pas été simple car c'est la première fois que je met le nez dans les classes. J'ai donc certainement fait quelques erreurs. N'hésitez pas à me les signaler.

Merci à SilkyRoad pour son tuto sur les évènements dans les graphiques.
Tutorial que vous pouvez retrouver ici : http://silkyroad.developpez.com/VBA/EvenementsGraphiques/

Merci à PCPT pour les corrections. Correction qui permettent à cette source d'être un vrai bon exemple d'utilisation de classe.

Cordialement

Commentaire de bigfish_le vrai le 22/10/2008 23:31:29

Salut,

ce n'est jamais tres agreable de ce prendre dans la figure des remarques sur la forme plutot que sur le fond mais que puis-je dire ?
Tu as raison pat50m! Et pour les accents... j'arrete des a present de faire le moindre effort.... et oui, au boulot je n'ai pas de droit suffisant pour changer la config d'XP(config americaine et clavier QWERTY). Donc j'abandonne meme si un text en francais sans accent et sans cedille est insuportable a la vue de certain d'entre vous.

Il partait dans la vie les mains vides, et méprisait les biens qui s'acquièrent. Pour pallier cette indigence, il ne lui restait qu'une issue: paraître (BEAUVOIR,Mém. j. fille, 1958, p.36)

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Collections de classes en VB [ par aKheNathOn ] J'ai codé une classe ayant des evenements, maintenant j'ai besoin de la dupliquer X fois, comme je le ferais avec un groupe de controles... seulement VB6: Evenements et récursivité? [ par YAKA ] Bonjour à tous... Bonjour la casse tete ...Je viens de passer un bout de temps sur un prb que je vous soumet.Faite une classe, C1_cls, avec: - une pro systray comment capturer les evenements [ par lebarn ] bjr tlmComment on capture les evenements de l'icone qu'on a mis dans le systray ?svpLebarn, c'est moi :: Search with Google</ Pb pour utiliser une classe [ par kozher20 ] Bonjour à tous,Voilà mon pb : dans mon programme, j'utilise des classes que j'ai créées : Ainsi par ex. Dim oClass as new MaClasseMais avec une classe classe API MySQL [ par goth ] salut allen fait je voudrais savoir si vous savez ou je peut trouver une classe (pcq c'est pratique) pour utiliser MYSQL via ses API (pcq c mieux que Evenement et classe [ par crazyjoke ] Bonjour je voudrais savoir comment récupérer un évènement dans un module de classe, l'objet étant déclaré comme ceci :dim truc as machenset true = new Mise à jour d'un ListBox à plusieurs colonne en vb [ par gallastrid ] Bonjour,j'ai un ListBox qui contient 5 colonnes et je souhaite afficher la liste à partir d'informations contenues dans une table.J'ai fais ma connexi Evenements et mdi childs [ par Lolux ] Bonjour,J'ai une appli MDI de gestion de base de données.Voilà ce que je voudrai :lorsque je valide un formulaire d'ajout d'enregistrement toutes les Aide utilisation classe internet explorer dans VB6...... [ par Alucard666 ] Bonjour,Une petite question comment faire pour utiliser la classe internet explorer (objet) et comment ouvrir un site par le bié de vb.Merci d'avance. Connaitre l'objet en cours dans un module de classe [ par AbeLeMudokon ] Mon projet (en visual basic 6) possède une classe nommée ClasseJoueur et un tableau Joueur(1 to 2) as New ClasseJoueur.Dans la boucle principale il y

Trouver une ressource

UN GRAPHIQUE 3D TOUT EN MOUVEMENT

Information sur la source

Description

Source

Conclusion

Fichier Zip

Historique

Sources du même auteur

Sources de la même categorie

Sources en rapport avec celle ci

Commentaires et avis

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Nos sponsors

Sondage...

CalendriCode

Côté IT

Formations Video Nouveau

Offres d'emploi

Appels d'offres

Téléchargements

Vidéos drôles Nouveau