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

• #28985 Delila_1 veterán Tsabee #28983

  Új Válasz 2015-10-12 11:16:28 #28985

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 ]

• #28984 Delila_1 veterán Tsabee #28983

  Új Válasz 2015-10-12 10:43:22 #28984

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 ]

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