123
返回列表 上一主題 發帖

[發問] 請大師們幫忙自動變換顏色,謝謝

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
11# 跳轉到 »
發表於 2015-5-11 13:15 | 只看該作者
回復 10# leirex1201

是只要A欄和B欄有值，然後從編輯的那一行A到K都變色對嗎？只要改紅字的部份就可以了
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 3 And Target.Row > 1 And Cells(Target.Row, "B") <> "" And Cells(Target.Row, "A") <> "" Then
    Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
        AA = col.Offset(0, 1).Interior.Color
    Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Interior.Color = _
    col.Offset(0, 1).Interior.Color
Else
    Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Interior.Color = 16777215
End If
End Sub

TOP

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
12#
發表於 2015-5-11 15:42 | 只看該作者
回復  leirex1201

是只要A欄和B欄有值，然後從編輯的那一行A到K都變色對嗎？只要改紅字的部份就可以了
...
lpk187 發表於 2015-5-11 13:15


感謝lpk187大師

測試已可以使用,我把最下面的else if拿掉了,不然編輯範圍以外的儲存格都會變成"白底色"
再次感謝lpk187大師的用心幫忙,感恩

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 11 And Target.Row > 1 And Cells(Target.Row, "B") <> "" And Cells(Target.Row, "A") <> "" Then
    Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
        AA = col.Offset(0, 1).Interior.Color
    Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Interior.Color = _
    col.Offset(0, 1).Interior.Color
End If
End Sub
天天空空啊~

TOP

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
13#
發表於 2015-5-11 15:49 | 只看該作者
回復  leirex1201

是只要A欄和B欄有值，然後從編輯的那一行A到K都變色對嗎？只要改紅字的部份就可以了
...
lpk187 發表於 2015-5-11 13:15



對了,忘了請問lpk187大師
我本身對顏色辨識較弱,
如果沒有相對應的色碼,太相似的顏色分不太清楚
有辦法自動標示相對應的色碼嗎...例如RGB或CMYK或HTML的FFFFFF

謝謝大師
天天空空啊~

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
14#
發表於 2015-5-11 19:19 | 只看該作者
回復 13# leirex1201

不用稱我大師，我也是初學者！

    說實在的以上的程式碼，我也是看到你的問題之後去做巨集，然後想出來的，而我找到的方法都沒辦法對應到RGB
但可以用RGB填入色彩，是否能對應到RGB色碼，就要請教其他大大們了！我找到的只有以下程式碼
Sub 巨集1()
Range("A1:A2").Interior.Color = RGB(0, 255, 1)'A1:A2儲存格填入色彩
Range("B1") = Range("A1").Interior.Color  '傳回A1物件的主要色彩
Range("B2") = Range("A2").Interior.ColorIndex    '傳回A2代表內景色彩
End Sub

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
15#
發表於 2015-5-11 23:44 | 只看該作者
感謝luhpro大師回覆

請問要貼到wookbook嗎?謝謝
leirex1201 發表於 2015-5-11 10:00

Private Sub cbGetColor_Click()
我是用按鈕事件來驅動,
每按一次就執行顏色檢核與變更.

TOP

hcm19522

帖子
1387 
主題
4 
精華
0 
積分
1397 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-11-21 

熱烈參與勳章
16#
發表於 2015-11-15 12:22 | 只看該作者
http://blog.xuite.net/hcm19522/twblog/354838322

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
17#
發表於 2015-11-15 17:30 | 只看該作者
儲存格色彩代碼.rar (6.59 KB)
請教各位大師

我想要依"公司清單"這個sheet裡列的公司,讓"設備列表"這個sheet裡面的設備自動整列變色成為 ...
leirex1201 發表於 2015-5-8 18:27


各顏色代碼~
在A1填上顏色，滑鼠離開A1移至任一儲存格後，B1可顯示該A1顏色的代碼。

Q1︰W7為各顏色代碼一覽表。

僅供參考。

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
18#
發表於 2015-11-15 17:36 | 只看該作者
不好意思~還不熟悉介面的操作~重發一次^^"

『因本身對顏色辨識能力較弱,其望可以有相應的色碼以供辨識』

各顏色代碼~
在A1填上顏色，滑鼠離開A1移至任一儲存格後，B1可顯示該A1顏色的代碼。

Q1︰W7為各顏色代碼一覽表。

http://www.FunP.Net/469452

僅供參考。

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
19#
發表於 2015-11-15 20:46 | 只看該作者
本帖最後由 yen956 於 2015-11-15 20:52 編輯

1. 在Module1中貼上下列VBA
  1. Public colorNum As Integer

  3. '先執行此VBA一次, 以建立代碼表(Sheet1)
  4. Sub 顏色代碼表()
  5.     Dim i As Integer
  6.     For i = 1 To 56
  7.         Sheets("Sheet1").Cells(i, 15) = i
  8.         Sheets("sheet1").Cells(i, 16).Interior.ColorIndex = i
  9.     Next
  10. End Sub
複製代碼
2. 在Sheet2中上下列VBA
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
  4.     Target.Interior.ColorIndex = colorNum
  5. End Sub
複製代碼
3. 在Sheet1中上下列VBA
  1. '尚未建立代碼表以前, 不要啟動此VBA
  2. '可先將 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3. '改成 Private Sub Worksheet_SelectionChange2(ByVal Target As Range)
  4. '建立完代碼表後即可啟動此VBA, 目的是取得 colorNum 的值
  5. '最後再到 sheet2 中,點欄B的存儲格, 即可得到所要的顏色
  6. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  7.     If Target.Count > 1 Then Exit Sub
  8.     If Intersect(Target, [P1:P56]) Is Nothing Then Exit Sub
  9.     colorNum = Target.Interior.ColorIndex
  10. End Sub
複製代碼
換言之, 用兩個 Worksheet_SelectionChange 來達成
test.gif

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
20#
發表於 2015-11-15 21:11 | 只看該作者
Sorry,全部貼在 sheet1 中就可以了
用Union就可以了
  1. Public colorNum As Integer

  3. '先執行此VBA一次, 以建立代碼表(Sheet1)
  4. Sub 顏色代碼表()
  5.     Dim i As Integer
  6.     For i = 1 To 56
  7.         Cells(i, 15) = i
  8.         Cells(i, 16).Interior.ColorIndex = i
  9.     Next
  10. End Sub

  12. '尚未建立代碼表以前, 不要啟動此VBA
  13. '建立完代碼表後即可啟動此VBA
  14. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  15.     Dim rng As Range
  16.     If Target.Count > 1 Then Exit Sub
  17.     Set rng = Application.Union([B:B], [P1:P56])
  18.     If Intersect(Target, rng) Is Nothing Then Exit Sub
  19.     If Target.Column = 16 Then
  20.         colorNum = Target.Interior.ColorIndex
  21.     Else
  22.         Target.Interior.ColorIndex = colorNum
  23.     End If
  24. End Sub
複製代碼
test.gif

TOP

        靜思自在 : 【蒙蔽的自由】人常在什麼都可以自由自在的時候，卻被這種隨心所欲的自由蒙蔽，虛擲時光而毫無覺知。
123
返回列表 上一主題