< návrat zpět

MS Excel

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

Zaslal/a lachatol 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

Zaslat odpověď >
Strana:  1 2   další »
Maximus(29.3.2017 13:09)#035829
avatar
Máš to hotové viz. tvoje příloha 5citovat
lachatol(29.3.2017 13:30)#035830
avatar
ss
Příloha: zip35830_formatokolocisla.zip (7kB, staženo 29x)
citovat
lachatol(29.3.2017 13:37)#035831
avatar
Znovu přidávám přílohu, prosím o pomoc
Příloha: zip35831_formatokolocisla.zip (7kB, staženo 27x)
citovat
a.mlady(29.3.2017 14:22)#035833
avatar
Snad na to stačí podm. formát, viz příloha.
Příloha: xlsx35833_formatokolocisla.xlsx (10kB, staženo 27x)
citovat
lachatol(29.3.2017 14:40)#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
a.mlady(29.3.2017 14:56)#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
nunus67(29.3.2017 15:10)#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 Subcitovat
Maximus(29.3.2017 17:04)#035841
avatar

nunus67 napsal/a:

dokazal by nekdo....


Hmmm, a jak to funguje?citovat
nunus67(29.3.2017 18:43)#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
Maximus(29.3.2017 19:18)#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

Formulář Faktura

Formulář Faktura IV

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

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje