Sub WordRevers(s)
Dim s1() As String
Dim i As Integer
Dim sTmp As String
'разбиваем предложение на слова
s1 = Split(s, " ")
For i = LBound(s1) To UBound(s1)
sTmp = s1(UBound(s1) - i)
'выполняем условие про большие и маленькие буквы
'если последенее слово, то делаем первую букву большой
If i = LBound(s1) Then sTmp = UCase(Left(sTmp, 1)) + Mid(sTmp, 2)
'если первое слово, то делаем все буквы маленькими
If i = UBound(s1) Then sTmp = LCase(sTmp)
'пишем результат
ActiveWorkbook.Worksheets(1).Cells(1, i + 1) = sTmp
'ActiveWorkbook.Worksheets(1).Range("A" & CStr(i + 1)).Value = sTmp
Next i
End Sub
Как изменить цвет текста с помощью WinApi
Подскажите, пожалуйста, как с помощью функций WinApi в макросе изменить цвет выводимого текста в ячейки Excel?
В ВинАпи есть функция для изменения цвета а как ее применить конкретном случае смотри сам:
COLORREF SetTextColor(
HDC hdc, // handle of device context
COLORREF crColor // text color
);
Parameters
hdc
Identifies the device context.
crColor
Specifies the color of the text.
COLORREF SetTextColor(
HDC hdc, // handle of device context
COLORREF crColor // text color
);
Parameters
hdc
Identifies the device context.
crColor
Specifies the color of the text.
А как её подключить к следующему макросу:
Где s1 текстовая строка. Именно цвет этого текста нужно и изменить!
Код:
Где s1 текстовая строка. Именно цвет этого текста нужно и изменить!
Цитата: MoM
А как её подключить к следующему макросу:
Для начала тебе необходимо получить HDC. Для отдельной ячейки Excel - это геморрой.
Если тебе необходимо изменить цвет в отдельных ячейках:
Код:
Sub WordRevers(s)
Dim s1() As String
Dim i As Integer
Dim sTmp As String
'разбиваем предложение на слова
s1 = Split(s, " ")
For i = LBound(s1) To UBound(s1)
sTmp = s1(UBound(s1) - i)
'выполняем условие про большие и маленькие буквы
'если последенее слово, то делаем первую букву большой
If i = LBound(s1) Then sTmp = UCase(Left(sTmp, 1)) + Mid(sTmp, 2)
'если первое слово, то делаем все буквы маленькими
If i = UBound(s1) Then sTmp = LCase(sTmp)
'пишем результат
ActiveWorkbook.Worksheets(1).Cells(1, i + 1) = sTmp
[COLOR=red]Selection.Font.ColorIndex = 3 'меняем цвет на красный:) [/COLOR]
'ActiveWorkbook.Worksheets(1).Range("A" & CStr(i + 1)).Value = sTmp
Next i
End Sub
Dim s1() As String
Dim i As Integer
Dim sTmp As String
'разбиваем предложение на слова
s1 = Split(s, " ")
For i = LBound(s1) To UBound(s1)
sTmp = s1(UBound(s1) - i)
'выполняем условие про большие и маленькие буквы
'если последенее слово, то делаем первую букву большой
If i = LBound(s1) Then sTmp = UCase(Left(sTmp, 1)) + Mid(sTmp, 2)
'если первое слово, то делаем все буквы маленькими
If i = UBound(s1) Then sTmp = LCase(sTmp)
'пишем результат
ActiveWorkbook.Worksheets(1).Cells(1, i + 1) = sTmp
[COLOR=red]Selection.Font.ColorIndex = 3 'меняем цвет на красный:) [/COLOR]
'ActiveWorkbook.Worksheets(1).Range("A" & CStr(i + 1)).Value = sTmp
Next i
End Sub
Цитата:
Для начала тебе необходимо получить HDC. Для отдельной ячейки Excel - это геморрой.
Так мне как раз нужно это сделать с помощью WinApi! Задание такое дали...
Цитата: MoM
Так мне как раз нужно это сделать с помощью WinApi! Задание такое дали...
Странное задание. Контекст отдельной ячейки тебе не получить, потому что ячейка - это не окно.
Поэтому можно извратиться таким образом:
Код:
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Sub WindowColor(sTmp As String, x As Long, y As Long)
Dim hWnd As Long
Dim hdc As Long
Dim pt As POINTAPI
GetCursorPos pt
hWnd = WindowFromPoint(pt.x, pt.y)
hdc = GetDC(hWnd)
'выставляем зеленый цвет
SetTextColor hdc, 65280
TextOut hdc, x, y, sTmp, Len(sTmp)
ReleaseDC hWnd, hdc
End Sub
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Sub WindowColor(sTmp As String, x As Long, y As Long)
Dim hWnd As Long
Dim hdc As Long
Dim pt As POINTAPI
GetCursorPos pt
hWnd = WindowFromPoint(pt.x, pt.y)
hdc = GetDC(hWnd)
'выставляем зеленый цвет
SetTextColor hdc, 65280
TextOut hdc, x, y, sTmp, Len(sTmp)
ReleaseDC hWnd, hdc
End Sub
и в твоей функции:
Код:
Sub WordRevers(s)
...
'ActiveWorkbook.Worksheets(1).Cells(1, i + 1) = sTmp
WindowColor sTmp, 28 + i * 64, 16
...
End Sub
...
'ActiveWorkbook.Worksheets(1).Cells(1, i + 1) = sTmp
WindowColor sTmp, 28 + i * 64, 16
...
End Sub
Ну, а с координатами и шириной ячеек прийдется тебе самому разобраться:)
Спасибо большое! Но он красит только одно последнее слово! А как применить эту ф-цию ко всем словам?
И почему изменяется не только цвет текста, но и фон (на тёмно-серый)? Как это исправить?
Если тебе не сложно, можешь написать, что значат все эти ф-ции?
И почему изменяется не только цвет текста, но и фон (на тёмно-серый)? Как это исправить?
Если тебе не сложно, можешь написать, что значат все эти ф-ции?
Да и вообще зачем что-то делать с ячейкой, если всего-то нужно изменить цвет текста, выводимого в ячейку (пусть весь текст хотя бы выводится в одну ячейку)?
Цитата: MoM
Спасибо большое! Но он красит только одно последнее слово! А как применить эту ф-цию ко всем словам?
И почему изменяется не только цвет текста, но и фон (на тёмно-серый)? Как это исправить?
Если тебе не сложно, можешь написать, что значат все эти ф-ции?
И почему изменяется не только цвет текста, но и фон (на тёмно-серый)? Как это исправить?
Если тебе не сложно, можешь написать, что значат все эти ф-ции?
Смотри внимательнее:
Код:
[COLOR=red]'[/COLOR]ActiveWorkbook.Worksheets(1).Cells(1, i + 1) = sTmp
Эта строка комментится, потому что писать мы будем не здесь.
Функция применяет цвет ко всему окну и рисует в этом окне текст. Если правильно расчитать координаты - будет выглядеть как вывод в ячейки, а иначе - просто текст поверх всего, что есть в окне.
GetCursorPos - Определяем текущую позицию курсора
WindowFromPoint - Находим окно, над которым раположен курсор
GetDC - Получаем контекст окна
SetTextColor - Устанавливаем цвет текста для контекста
TextOut - Рисуем текст в контексте
ReleaseDC - Освобождаем контекст
POINTAPI - структура, куда записываем координаты курсора
Но это все - полная лажа, текст не сохраняется, при перерисовке окна -исчезает.