Print side | Luk vindue

Checkboxe

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=981
Udskrevet den: 18.Maj.2024 kl. 10:06


Emne: Checkboxe
Besked fra: Lonny
Emne: Checkboxe
Posteringsdato: 27.Nov.2012 kl. 15:26


Hej
Jeg har et udsnit - se herunder (I hope) -fra en rapport generet via VBA i Excel
 
Chekbokse er sat med følgende kode
For Each cell1 In Range("A25:R200")
If cell1.Interior.Color = RGB(202, 255, 204) Then
 ActiveSheet.CheckBoxes.Add(cell1.Left + 6, cell1.Top, cell1.Width, cell1.Height).Select
    With Selection
     .Interior.ColorIndex = 0   'or  xlNone or xlAutomatic
     .Name = "bo" & cell1.Row
     .Caption = ""
     .OnAction = "sheet4.lonny1_change" ' testing
    End With
End If
If cell1.Interior.Color = RGB(203, 255, 204) Then
 ActiveSheet.CheckBoxes.Add(cell1.Left + 6, cell1.Top, cell1.Width, cell1.Height).Select
    With Selection
     .Interior.ColorIndex = 0   'or  xlNone or xlAutomatic
     .Name = "bo" & cell1.Row & "_" & cell1.Column
     .Caption = ""
     .OnAction = "sheet4.lonny2_change" ' testing
    End With
End If
If cell1.Interior.Color = RGB(204, 255, 204) Then
 ActiveSheet.CheckBoxes.Add(cell1.Left + 6, cell1.Top, cell1.Width, cell1.Height).Select
    With Selection
     .Interior.ColorIndex = 0   'or  xlNone or xlAutomatic
     .Caption = ""
    End With
End If
Next

Ved hak i checkbokse med overskriften All skal de efterfølgende 8 vandrette chekbokse sættes
Ved fravalg af et hak i en de 8 checkbokse benævnt med retningerne fra N til NW skal hakket i chekboksen med overskriften All fjernes. uploads/60/forum_spørgsmål.jpg - uploads/60/forum_spørgsmål.jpg
Har prøvet mig frem med diverse copy-pastet koder fra nettet, men intet har fungeret. Hvordan løser jeg dette?

Det skal bemærkes at jeg har flere rapporter valgt fra en forside og for hver af disse rapporter er placeringen af ”udsnittet” med Stationsfoto forskelligt – altså i forskellige rækkenr  og derfor har jeg valgt rækkenummer i navngivningen. Antallet af rækker (og dermed instrumenter) også er forskelligt  på hver rapport.
PÅ forhånd tak fra Lonny




Svar:
Besked fra: excelent
Posteringsdato: 03.Dec.2012 kl. 19:47
prøv:
Sub test()
'Koden forudsætter at Boxnavne er i format "Box_række_kolonne" fx Box_25_1
x = Application.Caller ' x=navn på checkbox der blev klikket
ræk = Mid(x, InStr(x, "_") + 1, InStrRev(x, "_") - InStr(x, "_") - 1) + 0 ' række i boxnavn
kol = Replace(Right(x, 2), "_", "") + 0 ' kolonne i boxnavn
flag = (ActiveSheet.Shapes(x).ControlFormat.Value = xlOn) ' True eller False
'Check for fjernelse af flueben i kolonner >A
If kol > 1 And flag = False Then
ActiveSheet.Shapes("Box_" & ræk & "_1").ControlFormat.Value = xlOff
End If
'Check for insætte flueben i kolonne A
If kol = 1 And flag = True Then
For t = 3 To 10
ActiveSheet.Shapes("Box_" & ræk & "_" & t).ControlFormat.Value = xlOn
Next
End If
End Sub
 


-------------
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!


Besked fra: Lonny
Posteringsdato: 04.Dec.2012 kl. 16:00
hej
Tusind tak for hjælpen og især koden.
Jeg "faldt" over application.caller forleden i anden sammenhæng og den er smart. Meget andet kode i mit program kan formodentlig erstattes med denne.
Jeg har hængt fast i click- og change-events længe mht mine checkboxe, hvilket jeg ikke kunne få at fungere. Og helt ærligt så forstår jeg ikke hvorfor, når det fungerer med andre boxe (ex combo). Men pyt mit problem er løst
 
Endnu engang tak fra Lonny


Besked fra: excelent
Posteringsdato: 04.Dec.2012 kl. 16:10
velbekom :-)

-------------
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!



Print side | Luk vindue