Repeterende code verkorten

[hoogteijling]

Hallo allemaal,
Weet iemand hoe deze code verkort kan worden.
Ik heb in mijn document nu een 78-tal knoppen staan die allemaal dezelfde functie hebben.
In de toekomst worden dit nog meer knoppen.
Het enige wat iedere knop doet is de tekst in de tabelcel ernaast het font toggelen van Arial naar Wingdings.
Ik gebruik dit in een Worddocument waarin inlognamen met wachtwoorden staan.
Wanneer iemand over mijn schouder meekijkt wil ik niet dat hij/zij alle wachtwoorden kan zien.

Private Sub CommandButton000_Click()
    ww_zien 0
End Sub
Private Sub CommandButton001_Click()
    ww_zien 1
End Sub
Private Sub CommandButton002_Click()
    ww_zien 2
End Sub
Private Sub CommandButton003_Click()
    ww_zien 3
End Sub
Private Sub CommandButton004_Click()
    ww_zien 4
End Sub
Private Sub CommandButton005_Click()
    ww_zien 5
End Sub
Private Sub CommandButton006_Click()
    ww_zien 6
End Sub
Private Sub CommandButton007_Click()
    ww_zien 7
End Sub
Private Sub CommandButton008_Click()
    ww_zien 8
End Sub
Private Sub CommandButton009_Click()
    ww_zien 9
End Sub
Private Sub CommandButton010_Click()
    ww_zien 10
End Sub
Private Sub CommandButton011_Click()
    ww_zien 11
End Sub
Private Sub CommandButton012_Click()
    ww_zien 12
End Sub
[COLOR="#FF0000"][B]Bovenstaand gaat door tot 078[/B][/COLOR]
Sub ww_zien(y)
    With Tables(1).Cell(y, 4).Range
        If .Characters(1).Font.Name = "Arial" Then
            .Font.Name = "Wingdings"
        Else
            For j = 1 To .Characters.Count - 1
                c02 = c02 & Chr(AscB(.Characters(j)))
            Next
            .Font.Name = "Arial"
            .Text = c02
        End If
    End With
End Sub

Groeten Marcel

 

[wampier]

knoppen direct op excel word hebben geen algemene handler en kunnen dan ook moeilijk gegroepeerd worden. Is het niet handiger om de CEL ernaast als trigger te gebruiken? of dubbelclicken op de gecodeerde cel zelf?

Even gemist dat het word was niet excel. de tekst blijft geldig echter. Ik moet even kijken of er een slimmere manier is in word

 

[hoogteijling]

Ik weet 0,0 van VBA dus ik weet niet hoe ik verder moet.
Ik wacht op je antwoord Wampier.

Groeten Marcel

Bekijk bijlage Wachtwoorden websites.doc
Je moet wel de extensie even naar .docm veranderen

 

[wampier]

Word bied zeer weinig houvast qua events. Ik zie in de documentatie niet zo snel een mogelijkheid om events af te vangen die je zou kunnen gebruiken. Mogelijk dat iemand met meer word ervaring een mogelijkheid ziet om toch wat te verkorten, maar ik zie zo geen houvast

 

[hoogteijling]

Is het in Excel dan wel mogelijk ?
Dan kan ik het overzetten naar Excel.

Groeten Marcel

 

[wampier]

In excel kun je het afvangen met dubbelclicken op de betreffende cel. Er zijn dan geen knoppen nodig en kun je het voor de betreffende range direct uitvoeren.

 

[snb]

Dat kan in Word ook.
Zie de bijlage. Dubbelklilk tussen de sterretjes.
Met minder code lijkt me heel lastig.

 

[hoogteijling]

@Wampier
Kun je daarvan een voorbeeldje posten ?

@SNB
Dat vind ik ook een hele mooie oplossing

Groeten Marcel

 

[wampier]

EXCEL:

ALT-F11 voor VBA. dubbelclick aan de linkerkant (project explorer) op "sheet 1" / "blad 1" (of welk sheet je dan ook wil gebruiken).

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    If Not Intersect(Target, [b:b]) Is Nothing Then
        If Target.Font.Name <> "Wingdings" Then
            Target.Font.Name = "Wingdings"
        Else
            Target.Font.Name = "trebuchet ms"
        End If
        Cancel = True
    End If
 
End Sub

dit werkt nu op alle items in kolom "B". Je kunt eenvoudig de intersect aanpassen met het bereik wat je wil hebben. De items veranderen nu met dubbelclick voor alle items in de intersect voor het gekozen tabblad.

 

[hoogteijling]

Nou Wampier, die Excel oplossing is ook een hele mooie.
Ik heb nu aardig wat keuzes. (2xWord en 1x Excel)

Wat ik merk bij de Word oplossing is dat het erg lang duurt voordat het document geopend is.
(zal wel door al die knoppen of tekstvelden komen)
De Excel versie vind ik tot nu toe de beste.
Ik denk dat ik daar mee verder ga.

Is het in Excel ook mogelijk om de karakters in sterretjes te laten veranderen ?

Groeten Marcel

 

[wampier]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    If Not Intersect(Target, [b:b]) Is Nothing Then
        If Target.NumberFormat = "General" Then
            Target.NumberFormat = ";;;****"
        Else
            Target.NumberFormat = "General"
        End If
        Cancel = True
    End If
 
End Sub

mogelijk moet het type aangepast worden, maar zo kan het in het algemeen. Op deze manier kun je ook de CEL kopieren zonder eerst zichtbaar te hoeven maken

 

[hoogteijling]

Dit is exact wat ik vanaf het begin al wilde. (Zie links)
GEWELDIG !!!
Allen dank voor het meedenken.

Groeten Marcel

http://www.helpmij.nl/forum/showthread.php/719235-VBA-code-werkt-niet-(Word)
http://www.helpmij.nl/forum/showthread.php/713897-Passwordveld-in-Word2007

 

[wampier]

Hoewel sommige programma's blijkbaar er niet helemaal goed mee omgaan. firefox plakt de sterretjes, niet de tekst. Word en andere office producten gaat meestal wel goed. Oh wel

 

[Warme bakkertje]

Iets korter

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, [b:b]) Is Nothing Then
       Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;****", "General")
       Cancel = True
    End If
 End Sub

 

[hoogteijling]

Dankje Warme bakkertje voor de nog kortere code.

Groeten Marcel

 

[snb]

mijn voorkeur

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 2 Then Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;*", "General")
    Cancel = True
End Sub

Maar wel gecombineerd met

Sub snb()
  Application.DisplayFormulaBar = False
End Sub

Want anders heb je nog steeds last van die collega's van je.

 

[hoogteijling]

Dank je SNB,
Maar mijn collega's mogen best 1 ww zien in de formulebalk, das geen probleem
Zolang ze maar niet de hele lijst in 1 keer zien is het voor mij goed genoeg.

Voorheen gebruikte ik de code van Warme Bakkertje en die werkt 100%.
Wanneer ik nu de code van SNB gebruik dan komt ie wanneer ik de sterretjes weer terug wil veranderen naar de "echte" tekens met de volgende foutmelding:

Ik heb de wachtwoorden nu trouwens in kolom D staan en daarom de code veranderd in:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 4 Then Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;*", "General")
    Cancel = True
End Sub

Groeten Marcel

 

[Warme bakkertje]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 4 Then Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;****", "General")
    Cancel = True
End Sub

 

[hoogteijling]

Bedankt Rudi

groeten Marcel

 

[snb]

Vreemd ?

    If Target.Column = 4 Then Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;*", "General")

geeft een fout

    If Target.Column = 4 Then Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;[COLOR="#FF0000"][B]**[/B][/COLOR]", "General")

geeft geen fout, en

   If Target.Column = 4 Then Target.NumberFormat = IIf(Target.NumberFormat = "General", ";;;[COLOR="#FF0000"][B]![/B][/COLOR]", "General")

evenmin