Kopieren ifv Bold/Italian

Status
Niet open voor verdere reacties.
R

Ron001

Gebruiker
Lid geworden
4 dec 2017
Berichten
384
Allen,

File in bijlage week 4 staat rechts vanboven "sneldienst" en "lakstraat"

Mijn vraag is als je in range (a16:a74) loonnummer in het "vet" zet, de naam van de persoon (b16:b74) gekopieerd wordt naar cel AA2 (de persoon die deze bepaalde week dan staat voor de sneldienst)
Hetzelfde maar dan cursief voor de persoon die de actuele week voor de lakstraat staat...cel AA3

Beiden links uitgelijnd...

Alvast bedankt!
 

Bijlagen

  • test sneldienst.xlsm
    991,5 KB · Weergaven: 41
Het wijzigen van een cel naar vet of cursief triggert geen event.
Dat zal dus op een andere manier nmoeten worden geregeld.
 
Misschien zo?
In plaats van vet of cursief te gebruiken in kolom A
Zet een S of L achter de nummer in kolom A
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim c As Range
    For Each c In ActiveSheet.UsedRange.Columns("A").Cells
        If c.Value Like ("*S") Then Range("AA2").Value = c.Offset(, 1).Value
        If c.Value Like ("*L") Then Range("AA3").Value = c.Offset(, 1).Value
    Next c
End Sub
 
Of zo:
Of zo, met een sneltoets (die <Ctr>+<b> vervangt bij mij)
Code: 
Sub mcrTriggerVet()
' Sneltoets: Ctrl+b
    If Not Application.Intersect(Selection, Range("D16:D74")) Is Nothing Then
        Selection.Font.Bold = Not Selection.Font.Bold
        If Selection.Font.Bold = True Then Range("H2").Value = ActiveCell Else: Range("H2").Value = ""
    End If
End Sub
 
Of:
Code: 
    For Each c In ActiveSheet.UsedRange.Columns("A").Cells
        If c.Font.Bold Then Range("AA2").Value = c.Offset(, 1).Value
        If c.Font.Italic Then Range("AA3").Value = c.Offset(, 1).Value
    Next c
 
@ Allen

Alvast bedankt voor de moeite.

Onderstaande code komt al in de buurt.

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)

 Dim c As Range
    For Each c In ActiveSheet.UsedRange.Columns("A").Cells
        If c.Font.Bold Then Range("AA2").Value = c.Offset(, 1).Value
        If c.Font.Italic Then Range("AA3").Value = c.Offset(, 1).Value
    Next c

End Sub

Maar ik krijg alleen "bold" te zien en cursief doet hij niets...
Als ik bold verwijder blijft naam staan, vak zou da terug leeg moeten worden.
Kan er ergens een veiligheid in dat "bold en cursief" maar één keer gebruikt kan worden? De laatste die de status "bold of cursief" gehad heeft, deze naam er komt te staan?

mvg
 
Allen,

Code blijft problemen geven

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)

 Dim c As Range
 Dim c2 As Range
    
    For Each c In ActiveSheet.Range("A16:A35")
    For Each c2 In ActiveSheet.Range("A40:A58")
        
        If c.Font.Bold Then Range("AA2").Value = c.Offset(, 1).Value
        If c.Font.Italic Then Range("AA3").Value = c.Offset(, 1).Value
     Next c
        
        If c2.Font.Bold Then Range("AA5").Value = c2.Offset(, 1).Value
        If c2.Font.Italic Then Range("AA6").Value = c2.Offset(, 1).Value
        
    Next c2

End Sub


Ik heb deze toch gewoon opgedeeld in twee delen? Ik de vroege en late shift zijn er telkens mensen met "sneldienst en lakstraat"
De Italic deed het en de bold niet....

Bedankt!
 
De problemen zitten niet in de code.
 
@ Snb

Verkeerd event?

Code: 
Sub sneldienst()

ActiveWorkbook.Unprotect "paswoord"
ActiveSheet.Unprotect "paswoord"

 Dim c As Range
 Dim c2 As Range
    
    For Each c In ActiveSheet.Range("A16:A35")
    
        
        If c.Font.Bold Then Range("AA2").Value = c.Offset(, 1).Value
        If c.Font.Italic Then Range("AA3").Value = c.Offset(, 1).Value
        
        Next c
        
    For Each c2 In ActiveSheet.Range("A40:A58")
     
        If c2.Font.Bold Then Range("AA5").Value = c2.Offset(, 1).Value
        If c2.Font.Italic Then Range("AA6").Value = c2.Offset(, 1).Value
        
        Next c2
  
    
ActiveSheet.Protect "paswoord"
ActiveWorkbook.Protect "paswoord"

End Sub
 
Ik ben nog eens aan het testen geweest, soms wordt code uitgevoerd, soms doet ie niets...
Kan iemand ook code eens testen aub?

Bedankt!
 
Plaats je document zoals hij nu is.

En juiste naamgeving is inderdaad belangrijk ;)
 
Weet het ff niet meer...

In bijlage...
 

Bijlagen

  • test sneldienst.xlsm
    994,2 KB · Weergaven: 33
Dat AA2 niet gevuld wordt is nogal wiedes.
De cel die Bold is is een samengevoegde cel, D27 is de eerst volgende offset(,1), en die is leeg.
AA3 wordt netjes gevuld.
 
Laatst bewerkt:
Plus dat je meerdere cellen in kolom A hebt die Bold zijn maar ook samengevoegd waardoor een eerdere vulling weer wordt leeg gemaakt. Doe het eens zo:
Code: 
Sub sneldienst()
    Dim c As Object
    ActiveWorkbook.Unprotect "paswoord"
    ActiveSheet.Unprotect "paswoord"

    For Each c In ActiveSheet.Range("A17:A35")
        If Range("B" & c.Row) <> "" Then
            If c.Font.Bold Then Range("AA2").Value = Range("B" & c.Row).Value
            If c.Font.Italic Then Range("AA3").Value = Range("B" & c.Row).Value
        End If
    Next c
        
    For Each c In ActiveSheet.Range("A40:A58")
        If Range("B" & c.Row) <> "" Then
            If c.Font.Bold Then Range("AA5").Value = Range("B" & c.Row).Value
            If c.Font.Italic Then Range("AA6").Value = Range("B" & c.Row).Value
        End If
    Next c

    ActiveSheet.Protect "paswoord"
    ActiveWorkbook.Protect "paswoord"
End Sub

VBA en samengevoegde cellen zijn geen vriendjes.
 
Laatst bewerkt:
@ Edmoor

Ziet er al veel beter uit.

Kan er nu nog iets bij dat er in elke range max één bold en italic is?
Als men bold en italic weghaalt ook de naam vanboven rechts terug weggaat?
 
Wat ik al eerder zei is dat het zetten van Bold of Italic, en dus ook het weghalen ervan, geen event triggert.
 
@ Edmoor

Het werkt eigenlijk voorlopig wel zoals ik wil :)

Nog 2 vragen:

1) Kan er ergens iets bij dat in de "range" maar één keer iets bold/italic kan "gezet" worden?
Als men een tweede wil inzetten; bv de eerste die er al staat oplicht/markeert of iets?

2) Als men iets bold/italic maakt de nummer gewijzigd wordt naar SNEL/LAK?
Als deze terug "normaal gezet wordt, de nummer terug zichtbaar wordt?

Alvast bedankt voor de moeite!

mvg
 
Dat zou allemaal wel geregeld kunnen worden middel het Worksheet_SelectionChange event.
Dat is echter wel wat werk om dat netjes te doen en luistert dusdanig nauw dat problemen op de loer liggen.
Ik zou er niet aan beginnen.
 
edmoor zei:
Wat ik al eerder zei is dat het zetten van Bold of Italic, en dus ook het weghalen ervan, geen event triggert.
Klik om te vergroten...

Dat is niet helemaal waar. Je kunt hiervoor wel een eigen event maken gebruik makend van het OnUpdate-event van de Commandbars. Zie bijgaand voorbeeld voor een bold-change event. Op dezelfde manier kan dat ook voor Italics-change.
 

Bijlagen

  • rebmog_boldchange_event.xlsm
    19,2 KB · Weergaven: 42
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan