EXCEL 2007 - VBA en automatique

micsel · 4 Novembre 2019

Bonjour,
Voila j'ai ce code que j'ai récuperé qui me permet de savoir ou j'en suis dans mes fichiers aux nombreuses lignes et colonnes.

J'ai lu qu'on pouvait activer cela sur tous les classeurs, seulement après des heures/jours a essayé de rentrer ce code dans perso.xlsb (en créant un module)
impossible que cela fonctionne.
aurais je fais une mauvaise manoeuvre ?
Je précise que cela fonctionne dans chaque classeur ou je l'intègre

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set champ = [A1:CZZ55000]
  If Not Intersect(champ, Target) Is Nothing Then
    On Error Resume Next
    Shapes("curseurH").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 1000, 1).Name = "curseurH"
    Shapes("curseurV").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationVertical, 1, 1, 1000, 1).Name = "curseurV"
    ActiveSheet.Shapes("curseurH").Line.ForeColor.RGB = RGB(255, 0, 0)
    Shapes("curseurH").Top = ActiveCell.Top + ActiveCell.Height
    Shapes("curseurH").Height = 1
    Shapes("curseurH").Width = champ.Width
    Shapes("curseurH").Left = champ.Left
    ActiveSheet.Shapes("curseurV").Line.ForeColor.RGB = RGB(255, 0, 0)
    Shapes("curseurV").Left = ActiveCell.Left
    Shapes("curseurV").Top = champ.Top
    Shapes("curseurV").Width = 1
    Shapes("curseurV").Height = champ.Height
  Else
    On Error Resume Next
    Shapes("curseurH").Visible = False
    Shapes("curseurV").Visible = False
  End If
End Sub

micsel · 4 Novembre 2019

j'y suis presque,
cela s'ouvre dans n'importe quelle feuille excel, seulement, j'ai un message erreur de compilation ...
et je ne vois pas où, pensez vous que je pourrais avoir une erreur de ' ?
le pire c'est que sur le classeur d'origine il fonctionne sans problème ... arggg, l'apprentissage est dur
(je remets un bout de code corrigé)

VB:

' LigneCouleur Macro
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set champ = [A1:CZZ55000]
  If Not Intersect(champ, Target) Is Nothing Then
    On Error Resume Next
    Shapes("curseurH").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 1000, 1).Name = "curseurH"
    Shapes("curseurV").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationVertical, 1, 1, 1000, 1).Name = "curseurV"
    ActiveSheet.Shapes("curseurH").Line.ForeColor.RGB = RGB(255, 0, 0)
    Shapes("curseurH").Top = ActiveCell.Top + ActiveCell.Height
    Shapes("curseurH").Height = 1
    Shapes("curseurH").Width = champ.Width
    Shapes("curseurH").Left = champ.Left
    ActiveSheet.Shapes("curseurV").Line.ForeColor.RGB = RGB(255, 0, 0)
    Shapes("curseurV").Left = ActiveCell.Left
    Shapes("curseurV").Top = champ.Top
    Shapes("curseurV").Width = 1
    Shapes("curseurV").Height = champ.Height
  Else
    On Error Resume Next
    Shapes("curseurH").Visible = False
    Shapes("curseurV").Visible = False
  End If
End Sub

Hasco · 4 Novembre 2019

Bonjour,

Vous avez une apostrophe devant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ça ne peut pas fonctionner.

cordialement

micsel · 4 Novembre 2019

Bonjour Roblochon,

Même en l'enlevant, j'ai toujours une erreur.
La le message est : une end sub est attendu ...

Merci pour ta réponse

Hasco · 4 Novembre 2019

Re,

Ca veut dire que plus haut sans doute, vous avez une macro Sub qui n'a pas sa ligne de fin END SUB!

micsel · 4 Novembre 2019

Re,

Voila le code complet, j'ai bien un END SUB (meme 2)

VB:

Sub LigneC()
' LigneC Macro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set champ = [A1:CZZ55000]
  If Not Intersect(champ, Target) Is Nothing Then
    On Error Resume Next
    Shapes("curseurH").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 1000, 1).Name = "curseurH"
    Shapes("curseurV").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationVertical, 1, 1, 1000, 1).Name = "curseurV"
    ActiveSheet.Shapes("curseurH").Line.ForeColor.RGB = RGB(255, 0, 0)
    Shapes("curseurH").Top = ActiveCell.Top + ActiveCell.Height
    Shapes("curseurH").Height = 1
    Shapes("curseurH").Width = champ.Width
    Shapes("curseurH").Left = champ.Left
    ActiveSheet.Shapes("curseurV").Line.ForeColor.RGB = RGB(255, 0, 0)
    Shapes("curseurV").Left = ActiveCell.Left
    Shapes("curseurV").Top = champ.Top
    Shapes("curseurV").Width = 1
    Shapes("curseurV").Height = champ.Height
  Else
    On Error Resume Next
    Shapes("curseurH").Visible = False
    Shapes("curseurV").Visible = False
  End If
End Sub

End Sub

Hasco · 4 Novembre 2019

Re
Une procédure ou fonction ne peut pas être imbriquée dans une autre

VB:

'interdit:

Sub truc()

  Sub AutreTruc() 'Sub imbriquée'

  End sub

End Sub



'Permis:

Sub Truc()

End Sub

Sub AutreTruc()

End Sub

Cordialement

micsel · 4 Novembre 2019

Donc en fait,
je crée la macro avec un sub LigneC macro
end sub
et ensuite je colle l'autre Sub
c'est ca l'idée ?

Hasco · 4 Novembre 2019

Re,

Non l'idée, l'idée c'est que vous sachiez ce que vous voulez, mais certainement pas imbriquer deux macros l'une dans l'autre.
donc soit vous supprimez Sub LigneC() et le End Sub correspondant,
en sachant que Private Sub Worksheet_SelectionChange(ByVal Target As Range)...End Sub est normalement une procédure évènementielle qui doit apparaître dans un module de code de feuille.
Mais je crois, que je parle chinois, pour vous, donc je vous suggère de vous trouver un bon tuto sur les base de vba et d'essayer de comprendre.

Cordialement

micsel · 4 Novembre 2019

ah oui je suis assez novice
je voulais juste avoir la ligne et la colonne avec le code que j'ai trouvé sur le net (qui fonctionne parfaitement pour un classeur)
Et donc je voulais le mettre démarrage de chaque classeur par le biais du personal

Hasco · 5 Novembre 2019

Bonjour,

Dans le fichier joint, le code se trouve dans le module ThisWorkbook pour qu'il fonctionne sur toutes les feuilles du classeur.
Pour qu'il fonctionne sur tous les classeurs ouverts à partir du classeur personnel, il faudrait rajouté dans celui-ci un module de classe application, ce que visiblement vous n'êtes pas prêt encore à faire, et que je ne vous ferez pas, car je n'assure pas le SAV.

Cordialement

micsel · 5 Novembre 2019

Bonjour Roblochon,

Le code fonctionne pour l'instant.
Je cherchais juste (et comme vous avez pu le lire) à le placer de sorte qu'il fonctionne sur chaque classeur ouvert, je l'avais mis dans le classeur personnel.
Je n'ai nullement demandé un SAV .... !
Je cherchais à comprendre, mais visiblement, vous prenez les gens de haut, car je pense que vous n’êtes pas devenu excellent en vba /macro excel seul, des personnes vous ont expliqué et vous avez creusé aussi .
J'apprend tous les jours, comme tout le monde, mais visiblement, pour vous; c'est soit on sait, sait on fait du SAV ...
Et, de ce fait, je ne pense que j'apprendrai beaucoup avec votre savoir..

Bien cordialement.

patricktoulon · 5 Novembre 2019

bonjour
si j'ai bien compris c'est une mire que tu souhaite

dans le module thisworkbook met plutôt ca et enleve ce que tu a mis dans le module des feuille

VB:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set champ = [A1:f20]' ADAPTE LA PLAGE QUE TU VEUX 
    Dim shp1 As Boolean, shp2 As Boolean, shap1 As Shape, shap2 As Shape

    For Each shap In ActiveSheet.Shapes
        If shap.Name = "curseurV" Then shp1 = True
        If shap.Name = "curseurH" Then shp2 = True
    Next
    If Not shp1 Then
        Set shap1 = ActiveSheet.Shapes.AddShape(1, 1, 1, 2000, 1): shap1.Name = "curseurH"
        shap1.Line.ForeColor.RGB = RGB(255, 0, 0)
    End If
    If Not shp2 Then
        Set shap2 = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 2000): shap2.Name = "curseurV"
        shap2.Line.ForeColor.RGB = RGB(255, 0, 0)
    End If

    If Not Intersect(champ, Target) Is Nothing Then
        With ActiveSheet.Shapes("curseurV"): .Top = 0: .Left = Target.Left: .Visible = True: End With
        With ActiveSheet.Shapes("curseurH"): .Top = Target.Top + Target.Height: .Left = 0: .Visible = True: End With
    Else
        ActiveSheet.Shapes("curseurH").Visible = False
        ActiveSheet.Shapes("curseurV").Visible = False

    End If
End Sub

micsel · 5 Novembre 2019

Bonjour Patrick,

je te joins ce que j'ai mis dans ma feuille, je trouve que cela me conviens parfaitement.
en fait ce que je voulais faire (et apprendre par la meme) c'etait de mettre cette mire de manière generale ; donc à chaque ouverture de classeur

Et merci pour ton code

patricktoulon · 5 Novembre 2019

re
j'ai virer ton code et mis le mien et c'est dans le module thisworkbook que ca va pas dans une feuille
tu l'a dispo dans toutes tes feuille

EXCEL 2007 - VBA en automatique

micsel

XLDnaute Junior

micsel

XLDnaute Junior

Hasco

XLDnaute Barbatruc

micsel

XLDnaute Junior

Hasco

XLDnaute Barbatruc

micsel

XLDnaute Junior

Hasco

XLDnaute Barbatruc

micsel

XLDnaute Junior

Hasco

XLDnaute Barbatruc

micsel

XLDnaute Junior

Hasco

XLDnaute Barbatruc

Pièces jointes

micsel

XLDnaute Junior

patricktoulon

XLDnaute Barbatruc

micsel

XLDnaute Junior

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Discussions similaires