< návrat zpět

MS Excel


Téma: Vybarvení buněk okolo zadaného čísla rss

Zaslal/a 29.3.2017 12:48

Prosím dokázal by někdo napsat makro na automatické vybarvení buněk černou okolo zapsaného čísla dle vzoru v příloze? Vyplnují se čísla od 0 do 4. Nula=žádné vybarvení, 1=buňky vlevo atd. dle vzoru. Dík

Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10

Strana:  1 2   další »
#035829
avatar
Máš to hotové viz. tvoje příloha 5citovat
#035830
avatar
ss
Příloha: zip35830_formatokolocisla.zip (7kB, staženo 29x)
citovat
#035831
avatar
Znovu přidávám přílohu, prosím o pomoc
Příloha: zip35831_formatokolocisla.zip (7kB, staženo 27x)
citovat
#035833
avatar
Snad na to stačí podm. formát, viz příloha.
Příloha: xlsx35833_formatokolocisla.xlsx (10kB, staženo 27x)
citovat
#035834
avatar
OK tohle asi zvládne i žák z 5. třídy, ale já to chtěl napsat makrem ve VBA pro určitou oblast buněk (větší oblast) v listu.......citovat
#035835
avatar

lachatol napsal/a:

OK tohle asi zvládne i žák z 5. třídy, ale já to chtěl napsat makrem ve VBA pro určitou oblast buněk (větší oblast) v listu.......


Děkuji za ocenění, mám jen 2 třídy PŠ.
Hlavně, že vy už to umíte.http://wall.cz/index.php?m=topic&id=29661#post-29666citovat
#035837
avatar
dokazal by nekdo....
Sub FormatRNG()
Dim Rng As Range
Dim C As Range

For Each C In ActiveSheet.UsedRange
If (C.Value = 0 Or C.Value = 1 Or C.Value = 2 Or C.Value = 3 Or C.Value = 4) And C.Value <> "" Then
Set Rng = Range(C.Offset(-1, -1), C.Offset(1, 1))
Rng.Borders(xlDiagonalDown).LineStyle = xlNone
Rng.Borders(xlDiagonalUp).LineStyle = xlNone
With Rng.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Rng.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Rng.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Rng.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Rng.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End If
Select Case C.Value
Case 1
Set Rng = Range(C.Offset(-1, -1), C.Offset(1, -1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Case 2
Set Rng = Range(C.Offset(-1, -1), C.Offset(1, -1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Set Rng = Range(C.Offset(1, 0), C.Offset(1, 1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Case 3
Set Rng = Range(C.Offset(-1, -1), C.Offset(1, -1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Set Rng = Range(C.Offset(1, 0), C.Offset(1, 1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Set Rng = Range(C.Offset(-1, 1), C.Offset(0, 1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Case 4
Set Rng = Range(C.Offset(-1, -1), C.Offset(1, -1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Set Rng = Range(C.Offset(1, 0), C.Offset(1, 1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Set Rng = Range(C.Offset(-1, 1), C.Offset(0, 1))
Rng.Interior.ThemeColor = xlThemeColorLight1
Set Rng = Range(C.Offset(-1, 0), C.Offset(-1, 0))
Rng.Interior.ThemeColor = xlThemeColorLight1
End Select
Next C
End Sub
Sub Clear()

Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
End With
End Sub
citovat
#035841
avatar

nunus67 napsal/a:

dokazal by nekdo....


Hmmm, a jak to funguje?citovat
#035845
avatar
Hmmm, a jak to funguje?
1. Copy kod
2. ALT+F11
3. V okne Projekt VBA-project prave tlacitko mysi => insert => module
4. Paste kod
5. Presun kurzor dovnitr: Sub FormatRNG()
6. F5citovat
#035846
avatar

nunus67 napsal/a:

5. Presun kurzor dovnitr: Sub FormatRNG()


Aha, a já ňouma pořád přepisoval v listu čísla a ono to nic nedělalo. Myslel jsem si já bláhový, že to bude fungovat už při změně buňky. Akurát napřed bych použil "Clear" a pak teprve "FormatRNG" anebo vložil odkaz na "Clear" do "FormatRNG". Při přepisu např: 4 na 1 to nefunguje, ale to asi není postatné. 8citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Excel - zápatí

masox22 • 28.2. 10:55

Současné rozplánování více projektů v Excelu -4

exceleda • 28.2. 10:04

Současné rozplánování více projektů v Excelu -4

elninoslov • 27.2. 22:52

konsolidace II.

pmiki • 27.2. 20:58

Současné rozplánování více projektů v Excelu -4

exceleda • 27.2. 18:36

Současné rozplánování více projektů v Excelu -4

elninoslov • 27.2. 14:30

Soubor bez přípony

elninoslov • 27.2. 14:26