Sub Test()
CopyWithColors "[price.xls]Sheet1!I5:I10", "[myfile.xls]Sheet2!A5:A10"
End Sub
Sub CopyWithColors(FromRange As String, ToRange As String)
Dim fr As Range, tr As Range
Dim FW As Workbook, TW As Workbook
Dim c As Range
Set fr = Evaluate(FromRange)
Set tr = Evaluate(ToRange)
Set FW = fr.Parent.Parent
Set TW = tr.Parent.Parent
fr.Copy
tr.PasteSpecial Paste:=xlPasteFormats
For Each c In fr.Cells
tr.Cells(c.Row - fr.Row + 1, c.Column - fr.Column + 1).Interior.Color = _
FW.Colors(c.Interior.ColorIndex)
tr.Cells(c.Row - fr.Row + 1, c.Column - fr.Column + 1).Font.Color = _
FW.Colors(c.Font.ColorIndex)
Next c
End Sub
Помогите с VBA
У меня проблема:
Есть документ Price.xls я хочу скопировать всё его содержимое (только оформление). Так вот в чём проблема: когда я "копирую" цвет фона яцейки и цвет текста, то в новом документе совсем другие цвета. Как зделать так, что б какие цвета были в старом документе такие были и в новом.
Есть документ Price.xls я хочу скопировать всё его содержимое (только оформление). Так вот в чём проблема: когда я "копирую" цвет фона яцейки и цвет текста, то в новом документе совсем другие цвета. Как зделать так, что б какие цвета были в старом документе такие были и в новом.
Цитата:
Originally posted by Kashuk
У меня проблема:
Есть документ Price.xls я хочу скопировать всё его содержимое (только оформление). Так вот в чём проблема: когда я "копирую" цвет фона яцейки и цвет текста, то в новом документе совсем другие цвета. Как зделать так, что б какие цвета были в старом документе такие были и в новом.
У меня проблема:
Есть документ Price.xls я хочу скопировать всё его содержимое (только оформление). Так вот в чём проблема: когда я "копирую" цвет фона яцейки и цвет текста, то в новом документе совсем другие цвета. Как зделать так, что б какие цвета были в старом документе такие были и в новом.
Вообще все должно было быть правильно. Но я сталкивался с такой проблемой, когда исходные документы были созданы (ну или просто изменены) не на собственно Экселе, а на непомнюкакназывается бесплатном эмулятора Экселя.
Мне это не мешало - удивился, да перекрасил. Сейчас попробую что-нибудь придумать для борьбы с этим.
Цитата:
Originally posted by Cutty Sark
Вообще все должно было быть правильно. Но я сталкивался с такой проблемой, когда исходные документы были созданы (ну или просто изменены) не на собственно Экселе, а на непомнюкакназывается бесплатном эмулятора Экселя.
Мне это не мешало - удивился, да перекрасил. Сейчас попробую что-нибудь придумать для борьбы с этим.
Вообще все должно было быть правильно. Но я сталкивался с такой проблемой, когда исходные документы были созданы (ну или просто изменены) не на собственно Экселе, а на непомнюкакназывается бесплатном эмулятора Экселя.
Мне это не мешало - удивился, да перекрасил. Сейчас попробую что-нибудь придумать для борьбы с этим.
Нет. Я использую только ексесь.
Цитата:
Originally posted by Kashuk
Нет. Я использую только ексесь.
Нет. Я использую только ексесь.
Ексесь - это страшная помесь Экселя и Аксесса? :D
Кажется, разобрался в чем дело.
Попробуй-ка вот такой макрос. Если заработает, объясню в чем фокус.
Код:
Что-то товарищ не пишет. Жаль, очень интересно, в том ли была проблема...
Цитата:
Originally posted by Cutty Sark
Ексесь - это страшная помесь Экселя и Аксесса? :D
Кажется, разобрался в чем дело.
Попробуй-ка вот такой макрос. Если заработает, объясню в чем фокус.
Ексесь - это страшная помесь Экселя и Аксесса? :D
Кажется, разобрался в чем дело.
Попробуй-ка вот такой макрос. Если заработает, объясню в чем фокус.
Код:
Sub Test()
CopyWithColors "[price.xls]Sheet1!I5:I10", "[myfile.xls]Sheet2!A5:A10"
End Sub
Sub CopyWithColors(FromRange As String, ToRange As String)
Dim fr As Range, tr As Range
Dim FW As Workbook, TW As Workbook
Dim c As Range
Set fr = Evaluate(FromRange)
Set tr = Evaluate(ToRange)
Set FW = fr.Parent.Parent
Set TW = tr.Parent.Parent
fr.Copy
tr.PasteSpecial Paste:=xlPasteFormats
For Each c In fr.Cells
tr.Cells(c.Row - fr.Row + 1, c.Column - fr.Column + 1).Interior.Color = _
FW.Colors(c.Interior.ColorIndex)
tr.Cells(c.Row - fr.Row + 1, c.Column - fr.Column + 1).Font.Color = _
FW.Colors(c.Font.ColorIndex)
Next c
End Sub
CopyWithColors "[price.xls]Sheet1!I5:I10", "[myfile.xls]Sheet2!A5:A10"
End Sub
Sub CopyWithColors(FromRange As String, ToRange As String)
Dim fr As Range, tr As Range
Dim FW As Workbook, TW As Workbook
Dim c As Range
Set fr = Evaluate(FromRange)
Set tr = Evaluate(ToRange)
Set FW = fr.Parent.Parent
Set TW = tr.Parent.Parent
fr.Copy
tr.PasteSpecial Paste:=xlPasteFormats
For Each c In fr.Cells
tr.Cells(c.Row - fr.Row + 1, c.Column - fr.Column + 1).Interior.Color = _
FW.Colors(c.Interior.ColorIndex)
tr.Cells(c.Row - fr.Row + 1, c.Column - fr.Column + 1).Font.Color = _
FW.Colors(c.Font.ColorIndex)
Next c
End Sub
У меня при этом выдает ошубку на "Set fr = Evaluate(FromRange)"
Может есть какой другой способ, для примера как я делал, может какую ошибку найдеш:
WS_NEW.Cells(1, 1).Font.Color = PPWS.Cells(1, 1).Font.Color
WS_NEW.Cells(1, 1).Interior.ColorIndex = PPWS.Cells(1, 1).Interior.ColorIndex
Цитата:
Originally posted by Kashuk
У меня при этом выдает ошубку на "Set fr = Evaluate(FromRange)"
Может есть какой другой способ, для примера как я делал, может какую ошибку найдеш:
WS_NEW.Cells(1, 1).Font.Color = PPWS.Cells(1, 1).Font.Color
WS_NEW.Cells(1, 1).Interior.ColorIndex = PPWS.Cells(1, 1).Interior.ColorIndex
У меня при этом выдает ошубку на "Set fr = Evaluate(FromRange)"
Может есть какой другой способ, для примера как я делал, может какую ошибку найдеш:
WS_NEW.Cells(1, 1).Font.Color = PPWS.Cells(1, 1).Font.Color
WS_NEW.Cells(1, 1).Interior.ColorIndex = PPWS.Cells(1, 1).Interior.ColorIndex
А что ж молчишь, раз ошибка...
Ошибка у тебя скорее всего из-за того, что ты неправильно функцию вызвал (в смысле - аргумент вида "[price.xls]Sheet1!I5:I10" неправильно ввел). Можем разобраться в этом, но тут суть не в этом. Раз уж у тебя есть ссылки на нужные тебе диапазоны, то их и используем.
fr - это твой PPWS, а tr - твой WS_NEW.
Можешь вставить вместо Evaluate-ов строчки
Set fr = PPWS
Set tr = WS_NEW
Должно заработать. Жду с нетерпением.