Keresés

Új hozzászólás Aktív témák

  • Delila_1

    veterán

    válasz Tsabee #28983 üzenetére

    Pontosabb, egyéni színkódokat is beállíthatsz. Az első makró helyett legyen

    Sub SzinLekerdezes()
    Dim Rh As Integer, Gh As Integer, Bh As Integer
    Dim Rk As Integer, Gk As Integer, Bk As Integer
    Dim hatter, karakter

    hatter = Selection.Interior.Color
    karakter = Selection.Font.Color

    Rh = hatter Mod 256
    Gh = (Int(hatter / 256)) Mod 256
    Bh = Int(hatter / 256 ^ 2)

    Rk = karakter Mod 256
    Gk = (Int(karakter / 256)) Mod 256
    Bk = Int(karakter / 256 ^ 2)

    MsgBox "Háttér RGB: " & Rh & ", " & Gh & ", " & Bh & vbLf & _
    "Karakter RGB: " & Rk & ", " & Gk & ", " & Bk
    End Sub

    a második helyett pedig ez

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sor As Long
    If Target.Column = 1 Then
    On Error Resume Next
    sor = Application.Match(Target, Range("N:N"))
    If VarType(sor) = vbError Then
    Exit Sub
    Else
    Range(Target.Address).Interior.Color = RGB(Cells(sor, "O"), Cells(sor, "P"), Cells(sor, "Q"))
    Range(Target.Address).Font.Color = RGB(Cells(sor, "R"), Cells(sor, "S"), Cells(sor, "T"))
    End If
    End If
    End Sub

    Ehhez a segédtáblát is bővítened kell.

    Az A6 cella 86-os értéke az előző makrókkal készültek, ott nem tudta hozni az egyéni háttérszínt.

    [ Szerkesztve ]

    Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

  • Delila_1

    veterán

    válasz Tsabee #28983 üzenetére

    Kezdjük az egyszerűbbel. Beírod a sorszámokat 1-től 7-ig. Mivel nem adtad meg, hol kellenek ezek a számok, az A1-ben kezdtem. Az A8 képlete =A1, ezt másolhatod, ameddig kell.

    A másikhoz 2 makró szükséges.
    Alt+F11-gyel belépsz a makró szerkesztőbe. Bal oldalon kiválasztod a füzetedet, ott is a ThisWorkbook lapot. A jobb oldalon kapott nagy fehér felületre bemásolod a makrót:

    Sub Szin_lekerdezes()
    MsgBox "Háttér színkód: " & Selection.Interior.ColorIndex & vbLf & _
    "Karakter színkód: " & Selection.Font.ColorIndex
    End Sub

    Ez azt csinálja, hogy kiírja egy üzenetben az aktív cella hátterének, és karakterének a színkódját.
    Összeállítasz egy segédtáblát, ahol az első oszlop tartalmazza a bevihető, színezendő számokat, a 2. oszlop a háttér-, a 3. a karakter színkódja lesz. Nálam ez a segédtábla az N:P oszlopokban van. Az N oszlopban beállítod a kívánt 2 színt, majd ráállsz az első számra, és indítod a fenti makrót (Alt+F8-ra megjelenő ablakban). A két kapott értéket beírod a megfelelő helyre. Ezt egyszer kell végig zongoráznod.

    Most jön a bevitt számok cellájának az automatikus színezése.
    Azt sem írtad meg, hova viszed be ezeket a számokat. A lenti makró az A oszlopba beírt számok celláját színezi. Ezt a makrót a lapodhoz kell rendelni. Lapfülön jobb klikk, újra a VB szerkesztőben vagy, abban is a lapodhoz tartozó üres felület jelent meg a jobb oldalon. Oda kell bemásolnod a kódot:

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
    On Error Resume Next
    Range(Target.Address).Interior.ColorIndex = _
    Application.WorksheetFunction.VLookup(Target, Range("N:P"), 2, 0)
    Range(Target.Address).Font.ColorIndex = _
    Application.WorksheetFunction.VLookup(Target, Range("N:P"), 3, 0)
    End If
    End Sub

    Ezzel kész az előkészület.
    Mikor beírsz egy számot az A oszlopba azok közül, amiket a segédtáblában megadtál, a kedvenc színösszeállításodra színezi a cellát. Olyan szám beírásánál, ami nem szerepel a segédtáblában, marad az eredeti háttér- és karakterszín.

    Kép hozzá:

    [ Szerkesztve ]

    Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

Új hozzászólás Aktív témák