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

• #23429 m.zmrzlina senior tag .OM. #23423

  Új Válasz 2014-09-24 12:47:05 #23429

  Ú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 .OM. #23423 üzenetére

  Próbáld ki ezt! Szerintem közel van ahhoz amit szeretnél. Úgy indítasz, hogy kijelölöd azt a tartományt aminek a szineit másolni szeretnéd és elindítod a makrót.

  Sub masol()
  
  Dim intSorok As Integer
  Dim intOszlopok As Integer
  Dim arrCopyColor()
  
  intSorok = Selection.Rows.Count
  intOszlopok = Selection.Columns.Count
  ReDim arrCopyColor(intSorok, intOszlopok)
  
  For i = 0 To intSorok
  For j = 0 To intOszlopok
  arrCopyColor(i, j) = Cells(ActiveCell.Row + i, ActiveCell.Column + j).DisplayFormat.Interior.Color
  Next
  Next
  
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "colors"
  
  For i = 1 To intSorok
  For j = 1 To intOszlopok
  Cells(i, j).Interior.Color = arrCopyColor(i, j)
  Next
  Next
  
  End Sub

• #23425 m.zmrzlina senior tag .OM. #23423

  Új Válasz 2014-09-24 10:40:26 #23425

  Ú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 .OM. #23423 üzenetére

  Ugye a legprofibb megoldás gondolom az lenne, hogy egy változóba kiírkálni a cellák DisplayFormat.Interior.Color tulajdonságát majd egy újonnan létrehozott munkalapon visszaírni.

  Vagy a másik, hogy ha van elég hely a munkalapodon akkor annyi oszloppal jobbra (vagy sorral lejjebb) másolni a formátumot ahol már nem zavar aztán Ctrl+C > formátum másolása az új munkalapra.

  Nyilván te is észrevetted, hogy annyit sántít a megoldás, hogy a nofill (nincs kitöltés) hátterű cellákból fehér (colorindex 2) hátterű cellák lesznek. Nem tudom ez mennyire baj.

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