• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Private Sub Zin beginnen met hoofdletters

  • Onderwerp starter Onderwerp starter HWV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.213
Beste,

Ik heb het volgende om een zin met een hoofdletter te laten beginnen.

Code: 
Sub ZinBeginnenMetEenHoofdletter()
    For Each cl In Cells.SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next
End Sub

Nu wil ik deze laten aanroepen zodra ik iets veranderd in mijn sheet door middel van de
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

dan kom de code er zo uit te zien.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cl In Cells.SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next
End Sub

Enkel deze werk niet.
Hoe kan ik deze werkend krijgen

Groet HWV
 
Deze doet dat voor u:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cl In Cells.SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next
End Sub

Maar ik zou u toch aanraden om het bereik te beperken tot het gebruikte gebied.

Cobbe

PS: Je moet de code in je werkblad zetten en niet in een module
 
Laatst bewerkt:
Blijf hangen

Beste ,

Bedankt voor uw reactie op mijn vraag.

Na de code te hebben getest is inderdaad beter dat ik een Range gaat definiëren.

Code: 
    For Each cl In Range("C19:C200").SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next

Ik heb deze geprobeerd, en er gebeurd het volgende:
- de eerste gaat goed
- bij de tweede krijg ik de zandloper te zien, en daar blijf hij staan.
Ik heb het bereik beperkt tot 1 kolom.

heb ik de code verkeerd staan.

groet HWV
 
Wat denk je van deze:

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For Each cl In Range("c19:c200").Cells.SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next
End Sub

Succes, Cobbe
 
Deze zou ook kunnen.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For Each cl In Range("A1:A30").Cells.SpecialCells(2) 'Range aan te passsen
        cl.Value = Application.WorksheetFunction.Proper(cl.Value)
    Next
End Sub

Proper is de engelse versie van "BEGINLETTERS".
 
fout melding nog steeds

Beste,

Ik krijg nog steeds foutmeldingen.
Op allebei de formules die ik toegereik heb gekregen.

Ik zet ze in de map waar het van toepassing is.

Zodra ik een veld aandruk, dan zal er een foutmelding komen.
Kunt u misschien voorbeeld bestandje er bij doen om voor mij te kijken wat ik verkeerd doe.

Alvast bedankt HWV
 
Waarom geen
Code: 
If Not Intersect(Target, Range("C19:C200")) Is Nothing Then
vervolg met je Lcase code
 
Code

Daniel,

Weer op de weg, met de champignons of zit er wat anders in de bak.
Ik snap wel wat je bedoel maar zou niet weten hoe ik dit nu moet gieten in een totaal formule.
Ik puzzel me rot.
Ga wel je tip opvolgen heb morgen twee weken vakantie, dus gaat het boek VBA eens goed doorspitten.
Kan jij verder helpen met de totaal code

groet Henk
 
Zet bovenaan je code eens
Code: 
On Error Resume Next
 
Henk ff OFF Topic toen ik je berichtje las moest ik intrersdect E313 E40 E25 E42 OF A604 kiezen , ik heb E40 gekozen als ik huis ben help ik .
los uit de hand target.value = target.valeu (Lcase
 
Formule

Beste,

Bedankt voor de hulp.
Ik denk dat het niet wil lukken met de rest van de code die ik erin heb staan.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
[COLOR="Red"]    For Each cl In Range("c19:c200").Cells.SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next[/COLOR]
'============================
'Artikelgegevens
'============================
If Target.Column = 2 Then
Target.Offset(, 1).Value = ""
Target.Offset(, 1).Value = Workbooks("PPP artikelbestand.xls").Sheets("Opslag").Columns(1).Find(Target.Value, , xlValues, xlWhole).Offset(, 21).Value
End If
If Target.Column = 2 Then
Target.Offset(, 16).Value = ""
Target.Offset(, 16).Value = Workbooks("PPP artikelbestand.xls").Sheets("Opslag").Columns(1).Find(Target.Value, , xlValues, xlWhole).Offset(, 27).Value
End If
'=============================
'adres gegevens
'=============================
Dim wsFrom As Variant
Set wsFrom = Workbooks("PPP afnemer1 bewerkt.xls").Sheets("Opslag").Range("A2:BL3000")
If Target.Address = [E6].Address Then
Call vinden
Application.EnableEvents = False
Range("E7").Value = Application.VLookup(Target.Value, wsFrom, 3, 0)
   If Range("E7") = "" Then Range("E7") = "Geen naam gevonden!"
   Range("E8").Value = Application.VLookup(Target.Value, wsFrom, 5, 0)
   If Range("E8") = "" Then Range("E8") = ""
   Range("E9").Value = Application.VLookup(Target.Value, wsFrom, 6, 0)
   If Range("E9") = "" Then Range("E9") = ""
   Range("F9").Value = Application.VLookup(Target.Value, wsFrom, 7, 0)
   If Range("F9") = "" Then Range("F9") = ""
  Range("E10").Value = Application.VLookup(Target.Value, wsFrom, 10, 0)
  If Range("E10") = "" Then Range("E10") = ""
   End If
Application.EnableEvents = True
'==============================
' afleveringen
'==============================
Set wsFrom = Sheets("Afleveradressen").Range("L2:T50")
If Target.Address = [O6].Address Then
Application.EnableEvents = False
Range("Q7").Value = Application.VLookup(Target.Value, wsFrom, 2, 0)
   If Range("Q7") = "" Then Range("Q7") = "Geen naam gevonden!"
   Range("Q8").Value = Application.VLookup(Target.Value, wsFrom, 4, 0)
   Range("Q9").Value = Application.VLookup(Target.Value, wsFrom, 5, 0) & " " & Application.VLookup(Target.Value, wsFrom, 6, 0)
   Range("Q10").Value = Application.VLookup(Target.Value, wsFrom, 9, 0)
   End If

Application.EnableEvents = True
'============================
'opmaak
'============================
If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, "C"), Cells(Target.Row, "P")).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic

End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic

End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic

End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With


If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With

If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, "Q"), Cells(Target.Row, "R")).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With

If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, "A"), Cells(Target.Row, "A")).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With

If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Range(Cells(Target.Row, "S"), Cells(Target.Row, "S")).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous 'xlDouble
.Weight = xlThin 'xlThick
.ColorIndex = xlAutomatic
End With
Target.Select
Application.ScreenUpdating = True
End Sub

Moet ik deze dan ergens anders in zetten, want ik krijg zo nog steeds de fout
Groet HWV
 
Beste Henk , probeer deze eens uit ;)
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For Each x In Range("C19:C200")
      x.Value = Application.Proper(x.Value)
   Next
End Sub
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, [C19:C200]) Is Nothing Then
        Target = Application.WorksheetFunction.Proper(Target)
    End If
End Sub
 
Laatst bewerkt:
Dit zou je zelfs gewoon kunnen oplossen dmv een interactie met de gebruiker... Zet in een validatie op die cel deze formule
Code: 
=CODE(LEFT(A1;1))<=90
(volgens mij is de NL functie voor 'code' óók code, en is left 'Links')

De gebruiker wordt dan 'op z'n vingers getikt' als de invoer niet met een hoofdletter begint. Dan ben je er toch ook?

Groet, Leo
 
Elk woord een hoofd letter

Rudi,

Met jou code maak je van elke woord, enkel de eerste letter een hoofdletter.
Is deze ook te realiseren dat enkel de begin van de zin begin met een hoofdletter zoals de normal code :
Code: 
   Sub ZinBeginnenMetEenHoofdletter()
    For Each cl In Cells.SpecialCells(2)
        cl.Value = UCase(Left(cl.Value, 1)) & LCase(Mid(cl.Value, 2))
    Next
End Sub

Groet Henk
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, [c19:c200]) Is Nothing Then
        Target = UCase(Left(Target, 1)) & LCase(Mid(Target, 2))
    End If
End Sub
 
...en in VBA zou je zoiets krijgen...
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, [C19:C200]) Is Nothing And Target.Cells.Count = 1 Then
        Target = UCase(Left(Target, 1)) & Mid(Target, 2)
    End If
End Sub

Je moet hier zeker géén For Each gaan inzetten! Dat is volkomen onnodig.

Groet, Leo

P.s. Maar toch.... Validatie???;)
 
Thanks

Rudi,

Dit was hem weer, je heb het weer gedaan.
Het zal de komende tijd even stil zijn van mijn kant.
ik ga van mijn welverdiede vakantie genieten.

Groet en bedankt aan diegene die heeft geholpen mijn probleem op te lossen

Henk
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan