错误为“下标超出范围”

Question

Am new to VBA Programming Kindly help me in getting the solution.

My code has to accept user defined excel files and take those values of the cells as log which are colored.I am getting error as "Subscript Out of range"

Public color_Change, color_Recall
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rcell As Range
    Dim CellData As String
    Dim fso As FileSystemObject

    Set fso = New FileSystemObject

    Dim stream As TextStream
    Set stream = fso.OpenTextFile("D:\Support.log", ForWriting, True)
    CellData = ""

    Dim vaFiles As Variant
    vaFiles = Application.GetOpenFilename()
    ActiveSheet.Range("B10") = vaFiles

    Set wb = Workbooks.Open(vaFiles)

    For Each vaFiles In ActiveWorkbook.Worksheets
        Worksheets(vaFiles.Name).Activate
        stream.WriteLine "The name of the Tab Sheet is :" & vaFiles.Name
        color_Change = getRGB2("A1")
        'color_Recall = getRGB2("A2")
        For Each rcell In vaFiles.UsedRange.Cells
            arrcolor = color_Change
            rcell.Interior.Color = getRGB1("A3")
            For Each color_Recall In ActiveSheet.UsedRange
                If rcell.Interior.Color = arrcolor Then
                CellData = Trim(rcell.Value)
                stream.WriteLine "The Value at location (" & rcell.Row & "," & rcell.Column & ") " & CellData & " " & rcell.Address
            End If
        'End If
        Next
    Next
    stream.WriteLine vbCrLf
    'Next
    'Next
    stream.Close
    MsgBox ("Job Done")
End Sub

Function getRGB2(ccell) As String
    Dim wkb As Workbook

    ThisWorkbook.Sheets(Sheet).Activate
    'wkb.Activate
    Dim i As Integer, rng As Range
    Dim r As Byte, g As Byte, B As Byte

    Set rng = Range(ccell)
    With rng.Interior
        r = .Color Mod 256
        g = .Color \ 256 Mod 256
        B = .Color \ (CLng(256) * 256)
    End With
    getRGB2 = r & "," & g & "," & B
End Function

Function getRGB1(ccell) As String
    Dim wkb As Workbook

    ThisWorkbook.Sheets(Sheet).Activate
    'wkb.Activate
    Dim i As Integer, rng As Range
    Dim r As Byte, g As Byte, B As Byte

    Set rng = Range(ccell)
    With rng.Interior
        r = .Color Mod 256
        g = .Color \ 256 Mod 256
        B = .Color \ (CLng(256) * 256)
    End With
    getRGB1 = r & "," & g & "," & B
End Function

Answer 1

I can't replicate your error but:

1. You don't need to Activate the sheets, you cant loop through the sheets if you qualify the getRGB1 and getRGB2 functions
2. You have a second loop looking at all cells ( color_Recall ) that doesn't seem to serve any purpose

suggest

For Each vafiles In ActiveWorkbook.Worksheets
    stream.WriteLine "The name of the Tab Sheet is :" & vafiles.Name
    color_Change = getRGB2(vafiles.Range("A1"))
        For Each rcell In vafiles.UsedRange.Cells
            arrcolor = color_Change
            rcell.Interior.Color = getRGB1(vafiles.Range("A3"))
            If rcell.Interior.Color = arrcolor Then
                 CellData = Trim(rcell.Value)
                  stream.WriteLine "The Value at location (" & rcell.Row & "," & rcell.Column & ") " & CellData & " " & rcell.Address
            End If
        Next
Next

Answer 2

The fundamental differences between Subs and Functions are

• A Sub can work on objects
• A Sub doesn't have a return value
• A Function can not change an object

• A Function will usually return something When you call

   ThisWorkbook.Sheets(Sheet).Activate 

  You are trying to change the Workbook object which isn't allowed.

I'm also not sure that ThisWorkbook.Sheets(Sheet) is a valid object unless you've defined Sheet as a global variable.

A Google search for

get rgb color excel

turned up this as the top result

Function getRGB2(rcell) As String
Dim C As Long
Dim R As Long
Dim G As Long
Dim B As Long

    C = rcell.Interior.Color
    R = C Mod 256
    G = C \ 256 Mod 256
    B = C \ 65536 Mod 256
    getRGB2 = R & "," & G & "," & B
End Function

From http://excel.tips.net/T010179_Determining_the_RGB_Value_of_a_Color.html

Answer 3

Function getRGB2(ccell) As String
Dim wkb As Workbook

ThisWorkbook.Sheets(Sheet).Activate

Instead try this:

Function getRGB2(ccell) As String
Dim wkb As Workbook ' or rename this to Dim ThisWorkbook As Workbook
Set wkb = ActiveWorkbook ' or rename this to Set ThisWorkbook = ActiveWorkbook
wkb.Sheets("Name of the sheet you want").Activate ' or rename this to ThisWorkbook.Sheets("Name of the sheet you want").Activate

I think what your problem is, is that you haven't decleard what wkb/ThisWorkbook will be, you have told it the varible it will be in the Dim but you have then done nothing with it, you need to tell the code which work book you want it to use, after that you can use it in your code.

Hope this helps

If you don't understand what I mean comment and i'll explain it in greater detail if I can.