EXCEL 2007 - VBA en automatique

[micsel]

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

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]

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é)

' 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]

Bonjour,

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

cordialement

 

[micsel]

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]

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]

Re,

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

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]

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

'interdit:

Sub truc()

  Sub AutreTruc() 'Sub imbriquée'

  End sub

End Sub



'Permis:

Sub Truc()

End Sub

Sub AutreTruc()

End Sub

Cordialement

 

[micsel]

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]

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]

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]

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]

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]

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

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]

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]

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