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

Quote

Weergeven resultaten 1 tot 16 van 16

Onderwerp: Excel Macro kleuren formule + opmaak

  1. #1
    Junior Member
    Geregistreerd
    14 februari 2018
    Vraag is 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 14: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
    Giga 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?

  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 15: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.

  11. #11
    Junior Member
    Geregistreerd
    14 februari 2018
    @jkpieterse dat is niet mogelijk bij een celverwijzing

  12. #12
    Junior Member
    Geregistreerd
    14 februari 2018
    @snb dankjewel, dat zorgt inderdaad voor een beter overzicht

  13. #13
    Giga Senior Haije's avatar
    Geregistreerd
    24 maart 2009
    Locatie
    Oldenzaal
    Afstand tot server
    ±97 km
    Quote Origineel gepost door Mike9910 Bekijk Bericht
    @jkpieterse dat is niet mogelijk bij een celverwijzing
    ?????? verklaar je nader.....
    Haije
    ___________________________________________________

  14. #14
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    Wist je dat....

    Code:
    Private Sub CommandButton2_Click()
       Sheet1.Shapes.Range([transpose(U3:U92)]).Fill.ForeColor.RGB = RGB(255, 255, 255)
    End Sub
    Code:
    Private Sub CommandButton1_Click()
      ReDim sn(Sheet1.Shapes.Count, 0)
      
      For Each it In Shapes
         If it.Type = 5 Then
            sn(j, 0) = it.Name
            j = j + 1
         End If
      Next
      Range("V3").Resize(UBound(sn) + 1) = sn
    
      For Each c In [T3:T92]
          Shapes(c).Fill.ForeColor.RGB = c.Interior.Color
      Next
    End Sub
    Laatst aangepast door snb : 19 februari 2018 om 12:11
    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.

  15. #15
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    @Mike

    Kijk eens in de forumregels !
    Plaats bestanden hier in het forum, niet elders.
    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.

  16. #16
    Junior Member
    Geregistreerd
    14 februari 2018
    Leveringen per postcode V3.xlsLeveringen per postcode V3.xls

    Zou iemand de code kunnen maken/verbeteren voor de kleur van de postcode + een opmaak voor b.v. boven die 10 leveringen rood vlak.

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