Excel / VBA - Kako stvoriti više potvrdnih okvira
Excel / VBA - Kako stvoriti više potvrdnih okvira
U ovom članku naučit ćete kako stvoriti potvrdne okvire koji se automatski povezuju s određenim ćelijama. VBA ne dopušta stvaranje više potvrdnih okvira odjednom. Možete ručno povezati potvrdne okvire s određenim ćelijama (Kopiraj / Zalijepi). Za svaku kopiju potvrdnog okvira morate odabrati ćeliju. To je prilično zamoran zadatak!
Početak rada
Vrsta kontrole
- Postoje dvije vrste potvrdnih okvira u Excelu: obrasci i ActiveX kontrole. U ovom članku koristit ćemo vrstu obrasca.
Izbjegavajte gomilanje Excel listova s previše stavki
- Excel ne rukuje uvijek dobro pretrpanom stranicom (prikazom), osobito ako namjeravate koristiti radnu knjigu na više verzija programa Excel.
Stvaranje potvrdnih okvira
Za svaki od potvrdnih okvira postoje dvije važne ćelije:- Položaj stanica : onaj koji ćemo povući naš okvir.
- Povezana stanica : ona u kojoj ćemo vratiti rezultat našeg potvrdnog okvira.
- Imajte na umu da su u ovom primjeru stanica stanice i povezana stanica iste. Provjerom ili poništavanjem ovog okvira vratit će se TRUE ili FALSE u povezanu ćeliju. Nažalost, Excel ne daje mogućnost postavljanja više potvrdnih okvira. Postoje dva moguća rješenja za prevladavanje ovog ograničenja:
Rješenje 1
Ovaj jednostavan VBA kod kada (ručno) pokreće, će generirati potvrdne okvire zajedno s povezanim stanicama.Kod
- Iz radne knjige pritisnite ALT + F11 da biste pristupili VBA uređivaču.
- Kliknite na Insert> Module .
- Kopirajte i zalijepite donji kod:
Opcija Eksplicitno Sub Inserer_Cases_a_cocher_Liees () Dim rngCel As Range Dim ChkBx Kao CheckBox za svaki rngCel u odabiru s rngCel.MergeArea.Cells Ako .Resize (1, 1) .Address = rngCel.Address Zatim 'Pour ne pas afficher la valeur de la cellule ".NumberFormat =" ;;; " Postavite ChkBx = ActiveSheet.CheckBoxes.Add (.Left, .Top, .Width, .Height) S ChkBx 'valeur par défaut: .Value = xlOff' pourrait True ou False 'cellule liée .LinkedCell = rngCel.MergeArea.Cells. Adresa 'Texte de remplacement' .Characters.Text = "TITI" 'texte' .Text = "Toto" 'ou: .Caption = "Toto"' bordure: Sa .Border 'Style de ligne' .LineStyle = xlLineStyleNone 'ou xlContinuous xlDashDot xlDashDotDot ili xlDot 'couleur' .ColorIndex = 3 '3 = rouge' epaisseur du trait '.Weight = 4 End Sa' accessibles aussi les propriétés .Locked, .Name, .Enabled etc ... End With End Završi sa sljedećim rngCel End Sub
Da biste koristili ovaj kôd:
Iz bilo kojeg dijela radne knjige:- Odaberite raspon ćelija u koje želite umetnuti potvrdne okvire,
- Pritisnite Alt + F8 .
- Odaberite modul i kliknite Pokreni .
Rješenje 2
U ovom primjeru koristit ćemo događaj Worksheet_SelectionChange kao okidač.Ovaj događaj automatski će pokrenuti kôd svaki put kada odaberete ćeliju (unutar određenog raspona).
Predloženi kôd će prelaziti kroz sve ćelije iz odabranog raspona, a ako je ćelija u fontu "Wingdings", umetnut će okvir za izbor.
Kod
Da biste umetnuli ovaj kôd:- Otvorite list po svom izboru.
- Desnom tipkom miša kliknite karticu lista> Prikaži kôd .
- Kopirajte i zalijepite donji kod:
Opcija Eksplicitno Privatni podradni list_SectionChange (ByVal Target As Range) 'Ograničenje de la plage. Ako je Intersect (Unija ([A2: A10], [D2: D10]), Target) ništa onda onda izađite iz Sub 'Plage A2: A10; D2: D10 Ako je Target. Count = 1 Ili Target.MergeCells Onda ako Target.Font.Name = "Wingdings" Onda s Target "cellule" liée ".Value = Abs (.Range (" A1 "). Vrijednost - 1) .NumberFormat =" "" ""; General; "" o ""; @ "Application.EnableEvents = Netočno .Range (" A1 ") Offset (, 1) .Odaberite Application.EnableEvents = Istinski kraj s krajem Da biste koristili ovaj kôd:
- Odaberite raspon ćelija.
- Primijenite font Wingdings.
- Kliknite bilo gdje na radnom listu, a zatim na svaku od prethodno odabranih ćelija.
Korištenje koda s zaštićenom radnom knjigom / listom
ActiveSheet.Protect "admin" 'admin = glasajte za passe' Stavite svoj kod OVDJE ActiveSheet.Unprotect "admin"
Ako je vaš list zaštićen, morat ćete ukloniti zaštitu koda. To se može postići korištenjem niže navedenog koda: