Есть ли способ извлечь значение из ячейки или диапазона ячеек на Sheet1 и поместить его в левый нижний колонтитул, а также установить цвет шрифта для нижнего колонтитула? - PullRequest
0 голосов
/ 21 мая 2019

Мне не удалось успешно установить атрибуты шрифта при извлечении диапазона ячеек из одного листа и установке этих значений в качестве верхнего / нижнего колонтитула для всей книги.и хочу перетащить диапазон ячеек с одного листа в заголовок для всей книги, но я также хочу установить цвет шрифта и т. д. Я попытался сослаться на одну ячейку, диапазон ячеек и сослаться нафункция, но ничего не похоже на работу.Вот мой код, с комментариями, которые, надеюсь, помогут:

Sub InsertHeaderFooter()
PURPOSE: Insert Image File into Spreadsheet Header or Footer on every selected worksheet
SOURCE: www.TheSpreadsheetGuru.com/the-code-vault(Modified by FiveLetterIan)


Dim WS As Worksheet
Dim ImgPath As String

'*** Call Function for Left footer
Dim LFRange As Range
Set LFRange = Worksheets("SetupPrint").Range("B3:C3")
Dim LFRange2 As Range
Set LFRange2 = Worksheets("SetupPrint").Range("B7:C7")
Dim leftFooter As String
leftFooter = lowerleft(LFRange) & lowerleft(LFRange2)

'*** Call Function for Right Footer
Dim RFRange As Range
Set RFRange = Worksheets("SetupPrint").Range("B11:C11")
Dim rightFooter As String
rightFooter = lowerleft(RFRange)

'Image Location
ImgPath = "c:\desktop\image.jpg"
'Does the Image File Exist?
On Error Resume Next
    Validation = Dir(ImgPath)
On Error GoTo 0

If Validation = "" Then
    MsgBox "Could not locate image file from:" & ImgPath
    Exit Sub
End If

Application.ScreenUpdating = False
 For Each WS In ThisWorkbook.Worksheets
                   With WS.PageSetup
                                       .LeftHeader = "LEFTHEADERTEXT"
                                       .RightHeaderPicture.Filename = ImgPath
                                            .Zoom = False
                                            .FitToPagesTall = False
                                            .FitToPagesWide = 1
                                       .leftFooter = leftFooter
                                       .rightFooter = rightFooter

                                    ''''Below are other things I've tried
                                       '.leftFooter = "&#153D70" & Sheet95.Range("C3").Value gets all text
                                       '.leftFooter = "#153D70leftFooter" gets "#153D70leftFooter" in black
                                       '.leftFooter = "&#153D70leftFooter" gets the text "153D70leftFooter" in black
                                       '.leftFooter = "&#153D70" & leftFooter gets the text "153D70 valuefromRangeB3:C3 valuefromRangeB7:C7" in black
                  End With
    Next WS
Set WS = Nothing
Application.ScreenUpdating = True
End Sub


'Left footer Function
Function lowerleft(ByVal LfooterRange As Range) As String

'*** Sets the range of cells on the "SetupPrint" Tab as a string for the insertheaderfooter subroutine
lowerleft = ""
 If Not LfooterRange Is Nothing Then
    Dim mycell As Range
    For Each mycell In LfooterRange
        lowerleft = lowerleft & " " & mycell.Value
    Next mycell
        End If
End Function

'Right footer Function
Function lowerright(ByVal RfooterRange As Range) As String
'*** Sets the range of cells on the "SetupPrint" Tab as a string for the insertheaderfooter subroutine
lowerright = ""
 If Not RfooterRange Is Nothing Then
    Dim mycell As Range
    For Each mycell In RfooterRange
        lowerright = lowerright & " " & mycell.Value
    Next mycell
    End If
End Function

Я продолжаю получать простой черный текст, и обычно также выводится команда VBA.

1 Ответ

0 голосов
/ 21 мая 2019

ОК, поэтому я использовал «& # 153D70» для получения цветового кода, основываясь на приведенной выше ссылке: «& color --- Печатает символы указанного цвета. Пользователь вводит шестнадцатеричное значение цвета». НО В НАЛИЧИИ правильный синтаксис - "& K153D70", и это прекрасно работает.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...