debutant en vba

[Mr Guizz]

Salut!
Comme l'indique cette discussion, je suis débutant en vba!
J'aimerais donc me specialiser!

j'ai créer un bouton que j'ai donc affecter a une macro .
Quand j'appuie sur celui ci , cela me créer un cercle correspondant a la taille du chiffre d'affaire.

J'aimerai maintenant ajouter une ligne a mon tableur et reussir a faire un deuxieme rond !
(qui correspond a cette nouvelle ligne !)
Le but étant au final de créer une 30aine de rond correspond au chiffre d'affaire des villes! (dans mon exemple)
Voici mon lien!

Sub LeCercle()

'efface toutes les formes presentes de A1 a D20'
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("$A$1:$D$20")) Is Nothing Then
s.Delete
End If
Next s

'creation d'un cercle'
Dim Rayon As Single
Rayon = Range("$F$2") / 10
ActiveSheet.Shapes.AddShape msoShapeOval, [c7].Left, [d2].Top, Rayon, Rayon

End Sub


MERKI !

 

[Yaloo]

Re : debutant en vba

Bonjour Mr Guizz et bienvenu sur XLD, le forum,

Avec un fichier se serait plus simple pour t'aider

Essaie de mettre des exemples de ce que tu as, et de ce que tu veux.

A te relire

Martial

 

[Mr Guizz]

Re : debutant en vba

j'ai remis la piece dans le premier message!
MERKI

 

[Yaloo]

Re : debutant en vba

Re,

Avec ceci :

Dim Rayon As Single
For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
Rayon = Range("$F$" & i) / 10
ActiveSheet.Shapes.AddShape msoShapeOval, [c7].Left, [d2].Top, Rayon, Rayon
Next

A+

 

[Mr Guizz]

Re : debutant en vba

Merci Yaloo...

... sans vouloir abuser .... serait -il possible que tu m'explique un peu , ce que veut dire chaque ligne?!

Dim Rayon As Single
For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
Rayon = Range("$F$" & i) / 10
ActiveSheet.Shapes.AddShape msoShapeOval, [c7].Left, [d2].Top, Rayon, Rayon
Next

merci et maintenant comment faire pour choisir la position de chaque rond.... et me l'exliquer..... (j'abuse...)

merki!

 

[job75]

Re : debutant en vba

Bonjour Mr Guizz, salut Yaloo,

Il faut une macro un peu plus élaborée si l'on veut faire quelque chose de sérieux :

Sub LeCercle()
Dim s As Shape, x#, y#, c As Range, d#
'efface toutes les formes des colonnes A:D
For Each s In ActiveSheet.Shapes
  If s.TopLeftCell.Column < 5 Then s.Delete
Next
'creation des cercles
x = [C2].Left
y = [C2].Top
For Each c In Range("F2", Cells(Rows.Count, 6).End(xlUp))
  If c <> "" Then
    d = c / 5 'rapport à adapter
    With ActiveSheet.Shapes.AddShape(msoShapeOval, x - d / 2, y, d, d)
      .Fill.ForeColor.RGB = RGB(56, 93, 138)
      .Fill.Visible = msoTrue
      .Line.ForeColor.RGB = RGB(56, 93, 138)
    End With
    y = y + d + 10
  End If
Next
End Sub

On pourrait mettre les noms des villes dans les cercles s'ils étaient tous assez grands.

Fichier joint.

A+

 

[Mr Guizz]

Re : debutant en vba

Beau resultat !

La finalité de mon projet est d'avoir une carte de France. Dessus les ronds correspondant aux 30 agences.
Les ronds grossissant selon le chiffre d'affaire de chaque agence!

Voici une piece jointe (avec la liste des agences)

 

[job75]

Re : debutant en vba

Re,

Pour ce genre de problème il ne faut pas créer les Shapes par macro mais manuellement.

Les positionner manuellement aussi sur la carte.

Puis vous renommez chaque Shape en lui donnant le nom de la ville.

Ensuite seulement vous faites une macro qui, à partir du tableau, redimensionne les Shapes (propriétés Width et Height) et les centre.

A+

 

[Mr Guizz]

Re : debutant en vba

je sens que je vais me faire gronder....

j'ai bien créer les ronds et je les ai renommé suivant la place qu'ils ont dans la liste
ex:1 Amiens correspond a un rond appele ville1
2 Beauvais correspond a un rond appele ville2 etc...

seulement la suite des operation est trop difficile pour moi!
En esperant qu'une ame charitable m'avance dans ce projet

Ah oui j'oubliai.... j'ai modifier mon fichier excel... donc les macros ne correspondent plus! oups!

 

[job75]

Re : debutant en vba

Re,

Voyez le fichier joint avec cette macro :

Sub Dimension_Cercles()
Dim c As Range, d#, x#, y#
On Error Resume Next 'facultatif (si une shape n'existe pas)
For Each c In Range("A2", Cells(Rows.Count, 1).End(xlUp))
  d = 0.4 * c(1, 3) 'coefficient à adapter
  With ActiveSheet.Shapes("Ville" & c)
    x = .Left + .Width / 2 'abscisse du centre
    y = .Top + .Height / 2 'ordonnée du centre
    .Width = d: .Height = d
    .Left = x - d / 2: .Top = y - d / 2
  End With
Next
End Sub

Des points rouges apparaissent, je ne sais pas ce que c'est

A+

 

[job75]

Re : debutant en vba

Re,

La visibilité est meilleure avec une couleur jaune :

.Fill.ForeColor.SchemeColor = 13 'jaune
.Line.ForeColor.SchemeColor = 13

Fichier (2).

Edit : je n'avais pas joint le fichier.

A+

 

[job75]

Re : debutant en vba

Re,

Dans les 2 fichiers précédents le diamètre du cercle est proportionnel au chiffre d'affaire.

Avec cette version (3) la surface du cercle est proportionnelle au chiffre d'affaire :

d = 3 * Sqr(c(1, 3)) 'coefficient à adapter

La fonction Sqr calcule la racine carrée.

A+

 

[Mr Guizz]

Re : debutant en vba

Job75

FELICITATION pour le resultat!
C'est franchement top!

Mais j'en ai pas finis encore avec toi !! (lol)

2 petites choses
1) est ce possible de changer la couleur en fonction du chiffre!?
de 10 a 20 en bleu
de 20 a 30 en vert
de 30 a 40 en jaune
etc....

2)serait il possible de m'expliquer un peu comment ca marche les macros, avoir un peu d'explication sur les mots ,que veut dire cette phrase...etc ? ou m'indiquer un site qui pourrait le faire car je ne veut pas non plus abuser de ta patience et de ton temps

Merci et encore BRAVO et FELICITATION pour ton taf

 

[Yaloo]

Re : debutant en vba

Bonjour Mr Guizz, Job,

a Job : Belle macro

a Mr Guizz : les améliorations demandées dans la macro ci-dessous (à adapter) , comme Job est allé manger , je prend la relève :

Sub Dimension_Cercles()
Dim c As Range, d#, x#, y#, Couleur#
On Error Resume Next 'facultatif (si une shape n'existe pas)
'Pour toutes les Cellules de A2 jusqu'à la dernière de la colonne A
For Each c In Range("A2", Cells(Rows.Count, 1).End(xlUp))
  'Calcul du diamètre
  d = 3 * Sqr(c(1, 3)) 'coefficient à adapter
  'Pour le Shape correspondant à Ville + valeur de c
  'Par exemple : pour Amiens, valeur de c = 1 (colonne A)
  'Alors Shape = Ville1
  With ActiveSheet.Shapes("Ville" & c)
    'Suivant le cas de c(1,3) c'est la valeur de la colonne C
    Select Case c(1, 3)
      'Si cette valeur est inférieur
      'alors Couleur prend la valeur 1,2,3,4 ou 13
      'Couleur à adapter
      Case Is <= 10: Couleur = 1
      Case Is <= 20: Couleur = 2
      Case Is <= 30: Couleur = 3
      Case Is <= 40: Couleur = 4
      Case Else: Couleur = 13
    End Select
    'Avec le Shape en cours, x est la position à gauche du Shape
    '+ la moitié de sa largeur
    x = .Left + .Width / 2 'abscisse du centre
    'Même principe pour la hauteur
    y = .Top + .Height / 2 'ordonnée du centre
    'Largeur et Hauteur = d calculé plus haut en fonction de la valeur en colonne C
    .Width = d: .Height = d
    'Positionnement du Shape à gauche (x = centre du Shape) - Rayon
    'Idem pour la hauteur
    .Left = x - d / 2: .Top = y - d / 2
    'Colorise la couleur de fond et la ligne de contour
    .Fill.ForeColor.SchemeColor = Couleur
    .Line.ForeColor.SchemeColor = Couleur
  End With
'Cellule suivante
Next
 End Sub

A+

Martial

PS à Job : si j'ai mal interprété et pas clair, corrige moi.

 

[Mr Guizz]

Re : debutant en vba

YALLO, JOB

UN GRAND MERKKKKKIIIII A VOUS !!!!!!

Yaloo, merci d'avoir pris le temps de m'expliquer......
Avec ca , je vais devenir un cador!!!
THANKS!!!!!!
juste , que veut dire cette phrase

Dim c As Range, d#, x#, y#, Couleur#

allez,
une dernière question.....voir si vous etes fort .... (lol)
est ce possible d'améliorer la couleur .... je m'explique
-avoir peut être un dégradé de jaune (ou de vert ou etc..) au lieu d'un jaune unis.
-avoir un léger contour noir autour de chaque shape ???
Peut etre que j'en demande un peu trop?!

Dans tout les cas , un grand merci a vous pour votre BEAU travail!