返回列表 上一主題 發帖

[發問] 自動開啟指定的檔案和標示底色。

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2019-8-26 01:43 | 只看該作者

[發問] 自動開啟指定的檔案和標示底色。

本帖最後由 ziv976688 於 2019-8-26 01:50 編輯

測試檔案 :   自動開啟指定的檔案.rar (114.66 KB)

請問 :下列需求的正確語法 ?
需求 :
1_自動開啟指定名稱的檔案~ EX :  "539_五行排序-??總覽-(####-##-##).xls"

2_將指定名稱的檔案開啟後，再將Sheet1和Sheet2的下列範圍標示15號底色      
        Range("BA3:BF12").Interior.ColorIndex = 15
        Range("BA15:BF24").Interior.ColorIndex = 15
        Range("BA27:BF36").Interior.ColorIndex = 15
        Range("BA39:BF48").Interior.ColorIndex = 15
        Range("BA51:BF60").Interior.ColorIndex = 15
        Range("BA63:BF72").Interior.ColorIndex = 15
        Range("BA75:BF84").Interior.ColorIndex = 15
3_將完成第2項需求的檔案關閉。      


以上 誠請各位大大幫忙! 謝謝各位!
收藏 分享

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
8#
發表於 2019-8-28 16:24 | 只看該作者
本帖最後由 ziv976688 於 2019-8-28 16:29 編輯

回復 7# 准提部林
感謝版主的指教。
原提問的程式碼也是擷取您的程式碼^^"
完全符合需求~再次感謝您^^

TOP

准提部林

帖子
2827 
主題
10 
精華
0 
積分
2883 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-10-27 
7#
發表於 2019-8-28 10:17 | 只看該作者
Sub TEST()
Dim P$, F$, xD, A, Tm, ADR$, xB As Workbook, xS As Worksheet
Tm = Timer
P = ThisWorkbook.Path
Set xD = CreateObject("Scripting.Dictionary")
Do
  If F = "" Then F = Dir(P & "\*.xls") Else F = Dir()
  If F = "" Then Exit Do
  If F Like "539_五行排序-??總覽-(####-##-##).xls" Then xD(F) = ""
Loop
If xD.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
ADR = "BA3:BF12,BA15:BF24,BA27:BF36,BA39:BF48,BA51:BF60,BA63:BF72,BA75:BF84"
For Each A In xD.keys
    Set xB = Workbooks.Open(P & "\" & A)
    For Each xS In xB.Sheets
        xS.Range(ADR).Interior.ColorIndex = 15
    Next
    xB.Close 1
Next
MsgBox Timer - Tm
End Sub


==================================

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
6#
發表於 2019-8-27 22:05 | 只看該作者
回復 5# s13030029
謝謝您的再次指教~可以了^^

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
5#
發表於 2019-8-27 09:10 | 只看該作者
回復 3# ziv976688
加個迴圈吧
  1. Sub 自動填色_Click()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Dim databook As Workbook
  5.     Path = ThisWorkbook.Path '檔案路徑
  6.    
  7.     For i = 1 To Sheets(1).Range("A300").End(xlUp).Row
  8.     Filename = Cells(i, "A").Value '檔名
  9.     Set databook = Workbooks.Open(Path & "\" & Filename) '開啟檔案
  10.     With databook.Sheets(1)
  11.         .Range("BA3:BF12").Interior.ColorIndex = 15
  12.         .Range("BA15:BF24").Interior.ColorIndex = 15
  13.         .Range("BA27:BF36").Interior.ColorIndex = 15
  14.         .Range("BA39:BF48").Interior.ColorIndex = 15
  15.         .Range("BA51:BF60").Interior.ColorIndex = 15
  16.         .Range("BA63:BF72").Interior.ColorIndex = 15
  17.         .Range("BA75:BF84").Interior.ColorIndex = 15
  18.     End With
  19.     With databook.Sheets(2)
  20.         .Range("BA3:BF12").Interior.ColorIndex = 15
  21.         .Range("BA15:BF24").Interior.ColorIndex = 15
  22.         .Range("BA27:BF36").Interior.ColorIndex = 15
  23.         .Range("BA39:BF48").Interior.ColorIndex = 15
  24.         .Range("BA51:BF60").Interior.ColorIndex = 15
  25.         .Range("BA63:BF72").Interior.ColorIndex = 15
  26.         .Range("BA75:BF84").Interior.ColorIndex = 15
  27.     End With
  28.     databook.Save  '儲存
  29.     databook.Close  '關閉
  30.     Next
  31.    
  32.     Application.ScreenUpdating = True
  33. End Sub
複製代碼

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
4#
發表於 2019-8-27 08:24 | 只看該作者
回復 3# ziv976688
我只指定"A1"儲存格為檔名
因為我不知道你要從哪裡設定你要變更檔案的檔名

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
3#
發表於 2019-8-27 07:50 | 只看該作者
回復 2# s13030029
感謝回覆。
測試結果:只有標示1個檔案，不是每一個檔案都有標示。

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
2#
發表於 2019-8-26 15:47 | 只看該作者
回復 1# ziv976688
大概是這樣吧~~
  1. Sub 自動填色_Click()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Dim databook As Workbook
  5.     Path = ThisWorkbook.Path '檔案路徑
  6.     Filename = Sheets(1).Range("A1").Value '指定名稱
  7.     Set databook = Workbooks.Open(Path & "\" & Filename) '開啟檔案
  8.     With databook.Sheets(1)
  9.         .Range("BA3:BF12").Interior.ColorIndex = 15
  10.         .Range("BA15:BF24").Interior.ColorIndex = 15
  11.         .Range("BA27:BF36").Interior.ColorIndex = 15
  12.         .Range("BA39:BF48").Interior.ColorIndex = 15
  13.         .Range("BA51:BF60").Interior.ColorIndex = 15
  14.         .Range("BA63:BF72").Interior.ColorIndex = 15
  15.         .Range("BA75:BF84").Interior.ColorIndex = 15
  16.     End With
  17.     With databook.Sheets(2)
  18.         .Range("BA3:BF12").Interior.ColorIndex = 15
  19.         .Range("BA15:BF24").Interior.ColorIndex = 15
  20.         .Range("BA27:BF36").Interior.ColorIndex = 15
  21.         .Range("BA39:BF48").Interior.ColorIndex = 15
  22.         .Range("BA51:BF60").Interior.ColorIndex = 15
  23.         .Range("BA63:BF72").Interior.ColorIndex = 15
  24.         .Range("BA75:BF84").Interior.ColorIndex = 15
  25.     End With
  26.     databook.Save  '儲存
  27.     databook.Close  '關閉
  28.     Application.ScreenUpdating = True
  29. End Sub
複製代碼

TOP

        靜思自在 : 得理要饒人，理直要氣和。
返回列表 上一主題