hoofdletter in een range of bereik

[spokkem]

hallo

ik heb het forum afgezocht naar een vba die in een range a1:al100 kleine letters omzet naar hoofdletters .

niet kunnen vinden.
ik vondt wel dit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Range
 Application.EnableEvents = False
    For Each b In Target.Cells
        If Not b.HasFormula Then _
        b = UCase(b)
    Next b
 Application.EnableEvents = True
End Sub

maar die werkt over de hele sheet dus nu kan ik nergens meer kleine letters typen
heeft iemand hier een aanvulling op of een andere oplossing

vr gr spokkem

 

[huijb]

Is dit iets voor je;
MAAKT VAN ELKE EERSTE LETTER EEN HOOFDLETTER

Sub ConvertToUpperCase()
Dim Rng As Range
For Each Rng In Selection.Cells
    If Rng.HasFormula = False Then
        Rng.Value = StrConv(Rng.Value, vbProperCase)
    End If
Next Rng
End Sub

MAAKT VAN KLEINE LETTERS ALLEMAAL HOOFDLETTERS.

Sub ConvertToUpperCase()
Dim Rng As Range
For Each Rng In Selection.Cells
    If Rng.HasFormula = False Then
        Rng.Value = UCase(Rng.Value)
    End If
Next Rng
End Sub

MAAKT VAN HOOFDLETTERS ALLEMAAL KLEINE LETTERS

Sub ConvertToLowerCase()
Dim Rng As Range
For Each Rng In Selection.Cells
    If Rng.HasFormula = False Then
        Rng.Value = LCase(Rng.Value)
    End If
Next Rng
End Sub

 

[Cobbe]

Je hoeft toch maar enkel de range aan te passen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Range
 Application.EnableEvents = False
    For Each b In Range("A1:A100")
        If Not b.HasFormula Then _
        b = UCase(b)
    Next b
 Application.EnableEvents = True
End Sub

Cobbe

 

[spokkem]

bedankt voor de reactie.

Huijb
ik heb die geprobeert maar daar wordt het workbook ontzettend traag van.
had ik ook al gevonden maar toch bedankt

Cobbe
jou stukje werkt het blijft nu binnen de range
maar ook hier wordt hij heel traag van.

bij de oude stand was hij heel snel maar daar is weer het nadeel dat hij het hele workbook doet.
ja het was een simpele range aanbrengen.
maar als je nog maar net een twee maanden bezig bent met vba dan gaat het bij een oude man nog niet zo snel sorry

misschien een andere oplossing zou welkom zijn

toch harstikke bedankt voor de hulp leer er alleen maar door.

vr gr spokkem
:shocked:

 

[Wigi]

Hoi

Zo kan je het volgens mij het beste doen:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim b As Range
    Dim rngIntersectie As Range
    Dim rngConstanten As Range
    
    Application.EnableEvents = False
    
    On Error Resume Next
    Set rngIntersectie = Application.Intersect(Target, Range("A1:A100"))
    On Error GoTo 0
    
    If Not rngIntersectie Is Nothing Then
    
        On Error Resume Next
        Set rngConstanten = rngIntersectie.SpecialCells(xlCellTypeConstants, 2)
        On Error GoTo 0
    
        If Not rngConstanten Is Nothing Then
        
            Application.EnableEvents = True
            
            For Each b In rngConstanten.Cells
                b.Value = UCase(b.Value)
            Next
            
            Application.EnableEvents = True
            
        End If
    
    End If
    
End Sub

Wigi

 

[spokkem]

wigi

bedankt voor deze

met dit stukje is hij wel sneller maar nu veranderd hij het hele workbook in hoofd letters
dit is nu net niet de bedoeling hij moet alleen in de range van h18:AL181 blijven.

ik ga wat rommelen met jou stukje en anders gebruik ik dan toch misscien het oude stukje

maaaaar hints blijven welkom

bedankt voor het snelle programmer werk
eens hoop ik dit ook zo uit mijn mouw te kunnen schudden zoals jullie doen

vr gr spokkem
:thumb:

 

[Wigi]

met dit stukje is hij wel sneller maar nu veranderd hij het hele workbook in hoofd letters
dit is nu net niet de bedoeling hij moet alleen in de range van h18:AL181 blijven.

Set rngIntersectie = Application.Intersect(Target, Range("[B]H18:AL181[/B]"))

 

[spokkem]

wigi

heb ik gedaan maar toch veranderd hij het hele workbook in hoofdletters

vr gr spokkem

 

[Wigi]

Waar staat welke code?

 

[spokkem]

wigi

ik heb jou progje met de verandering van de range
in de sheet van maart gezet
in worksheet / change

vr gr spokkem

 

[Wigi]

wigi

heb ik gedaan maar toch veranderd hij het hele workbook in hoofdletters

ik heb jou progje met de verandering van de range
in de sheet van maart gezet
in worksheet / change

Dat klopt niet. De code is dan enkel van toepassing op het blad maart. Hang anders een stukje van jouw file hier bij.

 

[spokkem]

wigi

hier is een stukje van de map
als je op start geeft hij een fout melding dit omdat hij waarschijnlijk een stuk mist van zijn bestand
ik heb de namen weg moeten halen ivm privicy
ik hoop dat je dat begrijpt
ik heb jou stukje hier in zitten en als je nu een letter invult dan zul je zien dat de hele sheet verandert in hoofdletters ondaks dat ik een range heb aangegeven.

vr gr spokkem

 

[Ginger]

Spokkem, je vraag gaat 2 kanten uit... In je initieele vraag wil je een complete range omzetten naar hoofdletters (daar komt Huijb met een paar prima oplossingen). In een later stadium moet het volgens mij gewoon per ingetikte regel in je aangegeven range. Volgens mij is dan deze code afdoende (als dezelfde range in alle sheets moet worden aangepakt; zet deze code in de ThisWorkbook module)...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    If Not Application.Intersect(Target, Range("H18:AL181")) Is Nothing Then
        Target.Value = UCase(Target.Value)
    End If

End Sub

Als het slechts om het aanpassen in 1 sheet gaat, gebruik je deze (code plaatsen in de sheet-module waar de aanpassing nodig is)...

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Application.Intersect(Target, Range("H18:AL181")) Is Nothing Then
        Target.Value = UCase(Target.Value)
    End If


End Sub

Het lijkt me namelijk volkomen overbodig om bij ieder 'change event' ALLE cellen in het aangegeven bereik weer langs te gaan... (De For...Each lus)

Maar het kan óók zijn dat ik nu de plank volledig mis sla!

Groet, Leo

 

[Wigi]

Zo gaat het wel:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim b As Range
    Dim rngIntersectie As Range
    Dim rngConstanten As Range
    
    On Error Resume Next
    Set rngIntersectie = Application.Intersect(Target, Range("h18:Al181"))
    On Error GoTo 0
    
    If Not rngIntersectie Is Nothing Then
        
        [B]Set rngIntersectie = Application.Union(rngIntersectie, Range("A1"))[/B]
    
        On Error Resume Next
        Set rngConstanten = rngIntersectie.SpecialCells(xlCellTypeConstants, 2)
        On Error GoTo 0
        
        If Not rngConstanten Is Nothing Then
        
            [B]Application.EnableEvents = False[/B]
            
            For Each b In rngConstanten.Cells
                b.Value = UCase(b.Value)
            Next
            
            Application.EnableEvents = True
            
        End If
    
    End If
    
End Sub

Wigi

 

[spokkem]

heren

Leo
bedankt voor de informatie
ik ga beide proberen.
en nee je slaat de plank nooit mis maar voor een beginner vond ik dit een juiste oplossing en het werkte.
ik ga dit aan passen en uitproberen.
maar ik kan pas antwoord geven over 4of 5 dagen moet op oefening(buiten spelen)

wigi

ik ga je progje ook uit proberen
bedankt voor de moeite die je er al ingestoken hebt.
ik laat nog weten hoe het afloopt
maar ik kan pas antwoord geven over 4of 5 dagen moet op oefening(buiten spelen)

vr gr spokkem:thumb::thumb:

 

[Wigi]

heren

Leo
bedankt voor de informatie
ik ga beide proberen.
en nee je slaat de plank nooit mis maar voor een beginner vond ik dit een juiste oplossing en het werkte.
ik ga dit aan passen en uitproberen.
maar ik kan pas antwoord geven over 4of 5 dagen moet op oefening(buiten spelen)

wigi

ik ga je progje ook uit proberen
bedankt voor de moeite die je er al ingestoken hebt.
ik laat nog weten hoe het afloopt
maar ik kan pas antwoord geven over 4of 5 dagen moet op oefening(buiten spelen)

vr gr spokkem

Dat wist ik al hoor

 

[Ginger]

(buiten spelen)

Nou nou Spokkem.... JIJ neemt je status van 'JUNIOR member' wel HEEL serieus!
Maar ff zonder dollen... veel plezier en we horen wel hoe het testen is afgelopen.

Groet, Leo

 

[spokkem]

Leo en Wigi

ik heb beide geprobeerd
ze werken beide goed
ik heb die van Wigi in het progje gestopt loopt goed nu hoofdletters bij de vleet

bedankt beide

vr gr spokkem:thumb:

 

[Ginger]

Spokkem, Prettig dat je hiermee geholpen bent. Wil je je vraag nog op 'opgelost' zetten?

Groet, Leo