Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 10 van 10

Onderwerp: Excel Macro kleuren formule + opmaak

  1. #1
    Junior Member
    Geregistreerd
    14 februari 2018
    Vraag is niet opgelost

    Excel Macro kleuren formule + opmaak

    Hallo,

    Ik heb een stukje code gepakt van een zeer verouderde topic. Ik wil er mee aan het werk gaan maar ik kom er niet uit.

    Code Sheet1
    Code:
    Option Explicit
    
    Private Sub CommandButton1_Click()
    Dim c As Range
    Dim myStr As String
    Dim lRed As Long
    Dim lGreen As Long
    Dim lBlue As Long
    Dim i As Integer, str As String
    Dim arr
    Range("V3:V1000").ClearContents
    For i = 1 To Shapes.Count
            
            With Shapes(i)
            
            If .Type = msoGroup Then
            
              .Ungroup
              End If
              End With
              Next
    For i = 1 To Shapes.Count
    With Shapes(i)
    If Left(.Name, 8) = "Freeform" Then
    str = str & "/" & .Name
    End If
    End With
    Next
    str = Mid(str, 2)
    arr = Split(str, "/")
    Range("V3").Resize(UBound(arr) + 1) = Application.Transpose(arr)
    For Each c In [U3:U92]
    On Error Resume Next
        myStr = Right("000000" & Hex(c.Offset(0, -1).Interior.Color), 6)
        lRed = Application.Evaluate("=Hex2dec(""" & Right(myStr, 2) & """)")
        lGreen = Application.Evaluate("=Hex2dec(""" & Mid(myStr, 3, 2) & """)")
        lBlue = Application.Evaluate("=Hex2dec(""" & Left(myStr, 2) & """)")
        Shapes(c).Fill.ForeColor.RGB = RGB(lRed, lGreen, lBlue)
       
     
    Next
    
    End Sub
    
    Private Sub CommandButton2_Click()
    Dim c As Range
    Dim myStr As String
    Dim lRed As Long
    Dim lGreen As Long
    Dim lBlue As Long
    
    
    
    
    For Each c In [U3:U92]
    On Error Resume Next
       
        
        Shapes(c).Fill.ForeColor.RGB = RGB(255, 255, 255)
     
    Next
    Range("V3:V1000").ClearContents
    End Sub


    Code Module 1
    Code:
    Option Explicit
    
    Sub ColorMap()
    Dim c As Range
    Dim myStr As String
    Dim lRed As Long
    Dim lGreen As Long
    Dim lBlue As Long
    Dim i As Integer, str As String
    Dim arr
    ActiveSheet.Range("U:U").ClearContents
    For i = 1 To ActiveSheet.Shapes.Count
            
            With ActiveSheet.Shapes(i)
            'str = ActiveSheet.Shapes(i).Name
            If .Type = msoGroup Then
            
              .Ungroup
              End If
              End With
              Next
    For i = 1 To ActiveSheet.Shapes.Count
    With ActiveSheet.Shapes(i)
    If Left(.Name, 8) = "Freeform" Then
    str = str & "/" & .Name
    End If
    End With
    Next
    str = Mid(str, 2)
    arr = Split(str, "/")
    ActiveSheet.Range("U3").Resize(UBound(arr) + 1) = Application.Transpose(arr)
    For Each c In [U3:U92]
    On Error Resume Next
        myStr = Right("000000" & Hex(c.Offset(0, 1).Interior.Color), 6)
        lRed = Application.Evaluate("=Hex2dec(""" & Right(myStr, 2) & """)")
        lGreen = Application.Evaluate("=Hex2dec(""" & Mid(myStr, 3, 2) & """)")
        lBlue = Application.Evaluate("=Hex2dec(""" & Left(myStr, 2) & """)")
        ActiveSheet.Shapes(c).Fill.ForeColor.RGB = RGB(lRed, lGreen, lBlue)
    
    Next
    
    End Sub
    postcode bestand orgineel.xls

    -------
    Ik wil graag toevoegen dat als het aantal b.v. boven 10 komt de postcode een rode opmaak krijgt, hoe doe ik dat?
    Laatst aangepast door Mike9910 : 14 februari 2018 om 15:24

  2. #2
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Plaats eerst eens je code in codetags, zo is het onleesbaar.
    "Hardware: The parts of a computer system that can be kicked. "
    Op rechtstreekse vragen via email reageer ik niet. Daar is het forum voor.

  3. #3
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    Die Marco staat er weer gekleurd op.
    VBA voor smarties
    VBA is een taal die je moet leren met een grammatica- en een woordenboek.

    http://www.helpmij.nl/forum/announcement.php?f=5
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  4. #4
    Junior Member
    Geregistreerd
    14 februari 2018
    Wat bedoel je hiermee?

  5. #5
    Mega Senior AlexCEL's avatar
    Geregistreerd
    3 april 2014
    Locatie
    Groningen
    Afstand tot server
    ±117 km
    Dat doelt op je onderwerptitel: "Excel Marco kleuren formule + opmaak"
    -- een voorbeeldbestandje zegt meer dan 1000 woorden --

  6. #6
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Quote Origineel gepost door Mike9910 Bekijk Bericht
    Ik heb een stukje code gepakt van een zeer verouderde topic. Ik wil er mee aan het werk gaan maar ik kom er niet uit.
    Ik denk dat je het jezelf al een stuk makkelijker maakt als je die code eerst eens voorziet van juiste inspringpunten en de overbodige lege regels verwijdert.
    Ondanks je codetags is dat de reden dat het nog steeds erg lastig lezen is.
    "Hardware: The parts of a computer system that can be kicked. "
    Op rechtstreekse vragen via email reageer ik niet. Daar is het forum voor.

  7. #7
    Junior Member
    Geregistreerd
    14 februari 2018
    Bedankt voor je feedback, maar zou niet weten hoe het nog duidelijker kan. Ik weet niet welke informatie bij mekaar zou moeten blijven staan.

  8. #8
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Als niemand me voor is zal ik dat vanavond voor je doen.
    "Hardware: The parts of a computer system that can be kicked. "
    Op rechtstreekse vragen via email reageer ik niet. Daar is het forum voor.

  9. #9
    Waarom regel je dit eigenlijk niet gewoon via voorwaardelijke opmaak?
    Groetjes,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  10. #10
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    De inhoud van de code heb ik niet bekeken.
    Het gaat om de leesbaarheid.

    Code:
    Private Sub CommandButton1_Click()
      Range("V3:V1000").ClearContents
    
      For each it in Shapes
         if it.Type = msoGroup Then it.Ungroup
      Next
    
      For each it in Shapes
         If Left(it.Name, 8) = "Freeform" Then str = str & "/" & it.Name
      Next
    
      sn=split(Mid(str, 2),"/")
      Range("V3").Resize(UBound(sn) + 1) = Application.Transpose(sn)
    
      For Each c In [T3:T92]
        Shapes(c).Fill.ForeColor.RGB = c.Interior.Color
      Next
    End Sub
    Laatst aangepast door snb : 14 februari 2018 om 16:27
    VBA voor smarties
    VBA is een taal die je moet leren met een grammatica- en een woordenboek.

    http://www.helpmij.nl/forum/announcement.php?f=5
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren
Aanbiedingen