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

• #16823 Mutt senior tag zhari #16821

  Új Válasz 2013-02-20 20:32:06 #16823

  Ú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

  

  Mutt

  senior tag

  válasz zhari #16821 üzenetére

  Hello,

  ...megnézni munkafüzetek füleinek a színét és egy meghatározott munkafüzet azonos nevű munkafüzeteinek a fül színét beszínezi...

  Ezt tudod használni.

  Sub Colorize()
  Dim arrayColor() 'lapnev és lapszín megnevezése
  Dim wbActual As Workbook
  Dim c As Long, i As Long
  Dim fileName As String
  Const refFile As String = "c:\reference.xlsm" 'referencia fájl neve helye
  Const filePath As String = "c:\list\" 'módosítandó fájlok helye
  Const fileExt As String = "*.xls" 'módosítando fájlok kitejesztése
  
  'a referencia alapján megjegyezzük a lapneveket és színeket
  Set wbActual = Workbooks.Open(refFile)
  ReDim arrayColor(1 To 2, 1 To wbActual.Sheets.Count)
  With wbActual
  For c = 1 To .Sheets.Count
  arrayColor(1, c) = .Sheets(c).Name
  arrayColor(2, c) = .Sheets(c).Tab.Color
  Next c
  End With
  wbActual.Close
  'végeztünk a referencia fájllal
  
  fileName = Dir(filePath & fileExt, vbNormal)
  'végigmegyünk a mappában lévő fájlokon
  Do While Len(fileName) > 0
  Set wbActual = Workbooks.Open(filePath & fileName)
  With wbActual
  For c = 1 To .Sheets.Count
  For i = 1 To UBound(arrayColor, 2)
  'ahol a lap neve egyezik ott szinezünk
  If .Sheets(c).Name = arrayColor(1, i) Then
  .Sheets(c).Tab.Color = arrayColor(2, i)
  End If
  Next i
  Next c
  End With
  wbActual.Save
  wbActual.Close
  fileName = Dir
  Loop
  
  End Sub

  üdv.

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