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

• #8756 Delila_1 veterán Swen_N #8752

  Új Válasz 2010-12-01 16:55:00 #8756

  Ú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 Swen_N #8752 üzenetére

  Itt egy másik megoldás, nem én követtem el, csak átvettem. A laphoz kell rendelni (lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutottál a VB szerkesztőbe, a jobb oldalon kapott üres lapra kell bemásolni. A cellára lépve megkapod a "célkereszt"-et.

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Cells.FormatConditions.Delete
  With Target
  With .EntireRow
  .FormatConditions.Add Type:=xlExpression, Formula1:="1"
  With .FormatConditions(1)
  With .Borders(xlTop)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = 5
  End With
  With .Borders(xlBottom)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = 5
  End With
  .Interior.ColorIndex = 20
  End With
  End With
  With .EntireColumn
  .FormatConditions.Delete
  .FormatConditions.Add Type:=xlExpression, Formula1:="1"
  With .FormatConditions(1)
  With .Borders(xlLeft)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = 5
  End With
  With .Borders(xlRight)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = 5
  End With
  .Interior.ColorIndex = 20
  End With
  End With
  
  .FormatConditions.Delete
  .FormatConditions.Add Type:=xlExpression, Formula1:="1"
  .FormatConditions(1).Interior.ColorIndex = 36
  End With
  End Sub

• #8754 m.zmrzlina senior tag Swen_N #8752

  Új Válasz 2010-12-01 15:25:37 #8754

  Ú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

  

  m.zmrzlina

  senior tag

  válasz Swen_N #8752 üzenetére

  Biztosan van rá egyszerűbb megoldás is, nekem ezt sikerült kiötleni. Akkor használható ha a munkalap celláinak eredetileg nincsenek olyan háttérszinei amelyeket nem szeretnél törölni.

  Úgy működik, hogy a cellába aminek a sorát és oszlopát ki szeretnéd emelni nyomsz egy dulpakattintást.

  Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  
  Dim sor As Long, oszlop As Long
  
  'aktív cella azonosítók
  sor = ActiveCell.Row
  oszlop = ActiveCell.Column
  
  Application.ScreenUpdating = False
  
  'korábbi háttérszín törlése
  Cells.Select
  Selection.Interior.Pattern = xlNone
  
  'aktív cellába vissza
  Cells(sor, oszlop).Select
  
  'aktív cella sorának háttérszíne
  ActiveCell.EntireRow.Select
  Selection.Interior.ColorIndex = 20
  
  'aktív cellába vissza
  Cells(sor, oszlop).Select
  
  'aktív cella oszlopának háttérszíne
  ActiveCell.EntireColumn.Select
  Selection.Interior.ColorIndex = 20
  
  'aktív cellába vissza
  Cells(sor, oszlop).Select
  
  Application.ScreenUpdating = True
  
  End Sub

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