Šipky v excelu 2007

[Poki]

V tomto pripade je lepsi vlozit sipku do bunky, ke ktere se vztahuje, tedy k cene 2010
(do prazdne bunky asi vlozit vubec nejde)

[Reklama]

[navstevnik]

Pozadovaneho vysledku - vlozit do E3 rozdil hodnot C3:D3 a pridat barevnou sipku lze pouzitim procedur VBA.
Udalostni procedura v modulu list1 (zmena v bunkach sloupce C:D) zavola proceduru ve standardnim modulu a preda odkaz na vysledkovou bunku - E:E. Volana procedura vlozi do vysledkove bunky rozdil dvou bunek vlevo od vysledkove bunky a prida prislusne obarvenou sipku.
Volajici procedra je demonstracniho charakteru a lze ji patricne upravit, zejmena osetrit zmenu ve vice bunkach,...
vlozit do modulu list1:

Kód: Vybrat vše

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Cells.Count = 1 Then
    If Not Intersect(Target, Me.Range("c:d")) Is Nothing Then
      ' volat proceduru, predat odkaz na vysledkovou bunku
      InsertArrowKeys Target.Offset(0, IIf(Target.Column = 3, 2, 1))
    End If
  End If
End Sub

vlozit do standardniho modulu:

Kód: Vybrat vše

Option Explicit

Sub InsertArrowKeys(ByVal Cll As Range)
  Dim ColInd As Byte
  With Application
    .EnableEvents = False
    With Cll
      ' vlozit rozdil bunek vlevo
      .Value = .Offset(0, -1).Value - .Offset(0, -2).Value
      ' vlozit znaky pro sipky ve fontu Wingdings 3 a urcit colorindex
      If .Value > 0 Then
        .Value = .Value & " " & Chr(199) ' kod znaku 0xC7, sipka nahoru
        ColInd = 3
      ElseIf .Value < 0 Then
        .Value = .Value & " " & Chr(200) ' kod znaku 0xC8, sipka dolu
        ColInd = 50
      Else
        .Value = .Value & " " & Chr(198) ' kod znaku 0xC6, sipka napravo
        ColInd = 44
      End If
      ' upravit fontcolor a zmena fonttype na Wingdings 3
      With Cll.Characters(Start:=Len(Cll.Value), Length:=1).Font
        .Name = "Wingdings 3"
        .ColorIndex = ColInd
      End With
      Set Cll = Nothing
    End With
    .EnableEvents = True
  End With
End Sub

Sub Test()
' test procedury
  InsertArrowKeys ActiveSheet.Range("e8")
End Sub

Pro jistotu je pripojen soubor

[Luboš]

OK, takže makro pro zobrazení šipky dolu na aktuální pozici kurzoru je:

Sub sipka_dolu()
With Selection.Font
.Name = "Symbol"
.Size = 11
.Bold = True
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveCell.FormulaR1C1 = ChrW(175)
End Sub

Pro zobrazení šipky nahoru dej do posledního příkazu ChrW(173)

[amaroun]

Tak koukám, že teď už je na mě aplikovat makra v sešitu, zatím tedy navím jak.

[navstevnik]

Jak nato treba zde: http://www.officir.ic.cz/excelentne.html
nebo zde: http://www1.osu.cz/studium/vawin/~studijni.opory/
a lze pouzit i pro Excel 2007/2010

[mike007]

Mám excel 2007 a potřebuji šipkami znázornit v tabulce změnu ceny v návaznosti na vzorec, tedy třeba zelená šipka v buňce ukazuje snížení ceny, červená šipka zvýšení.Snažil jsem se to hledat, ale bez výsledku.

Do přílohy jsem ti hodil vizualizaci dat od Jiřího Číhaře. Třeba tam najdeš inspiraci pro úpravu svého dokumentu.

[amaroun]

Jak nato treba zde: http://www.officir.ic.cz/excelentne.html
nebo zde: http://www1.osu.cz/studium/vawin/~studijni.opory/
a lze pouzit i pro Excel 2007/2010

Díky za odkazy

Mám excel 2007 a potřebuji šipkami znázornit v tabulce změnu ceny v návaznosti na vzorec, tedy třeba zelená šipka v buňce ukazuje snížení ceny, červená šipka zvýšení.Snažil jsem se to hledat, ale bez výsledku.

Do přílohy jsem ti hodil vizualizaci dat od Jiřího Číhaře. Třeba tam najdeš inspiraci pro úpravu svého dokumentu.

Inspirace dobrá, myslím že teď už je to na samostudiu

// Příspěvky sloučeny.
// Pokud chceš něco dodat a ještě nikdo po tobě nepřispěl, použij tlačítko >> Upravit << a svůj příspěvek doplň. Díky.
//mike007