Добрый день...У меня есть табличка в Excel,для неё написан Макрос.  
Макрос выделяет определенным цветом,те вещи которые сделанны или не сделанны..  
Но после того как поменяли одно название в Макросе,он почему то именно с одним названием,неправильно выдает ответ,не правильно работает...Как мне это исправить?кто то реально может в этом помочь!!!  
Sub CheckAll()  
Dim i As Integer  
Dim j As Integer  
 
Dim PathFull As String  
Dim PathTemp As String  
 
Dim FileNotFound As Long  
Dim NoteNotFound As Long  
Dim DoubleNote As Long  
 
Dim LastCol As Integer  
Dim LastRow As Long  
 
Dim MyName As String  
Dim MyPath As String  
Dim FindBool As Byte  
Dim FolderID As Byte  
Dim FileID As Byte  
Dim DateID As Byte  
Dim ErrorBool As Boolean  
Dim LastNumberAdd As Integer  
Dim RemoveFileName As String  
 
'Пареметры:  
   PathFull = Sheets("Options").Cells(1, 2)  
   PathTemp = Sheets("Options").Cells(2, 2)  
   FileNotFound = Sheets("Options").Cells(3, 2).Interior.Color  
   NoteNotFound = Sheets("Options").Cells(4, 2).Interior.Color  
   DoubleNote = Sheets("Options").Cells(5, 2).Interior.Color  
   LastNumberAdd = 1  
 
   Sheets("Data").Select  
 
With ActiveSheet  
 
   LastCol = .Range("A1").End(xlToRight).Column  
     
   For i = 1 To LastCol  
       .Cells(1, i).Interior.Color = Sheets("Options").Cells(6, 2).Interior.Color  
       Select Case .Cells(1, i)  
       Case "Êîíòðàãåíò": FolderID = i  
       Case "Íîìåð": FileID = i  
       Case "ÇàïàêîâàíîÄàòà": DateID = i  
       End Select  
   Next  
     
   LastRow = .Cells(65536, FolderID).End(xlUp).Row  
     
'Удаляем розовые",  
   For i = 2 To LastRow  
       For j = 1 To LastCol  
           If .Cells(i, j).Interior.Color = NoteNotFound Then  
               .Cells(i, j) = ""  
           End If  
           .Cells(i, j).Interior.Color = RGB(255, 255, 255)  
       Next  
   Next  
     
'Сортируем:  
   .Range(Cells(2, 1), Cells(LastRow, LastCol)).Sort Cells(1, FolderID), , Cells(1, FileID)  
     
   LastRow = .Cells(65536, FolderID).End(xlUp).Row  
     
'Проверяем:  
   For i = 2 To LastRow + 1  
       FindBool = 2  
         
       If i > 2 Then  
           If MyPath = .Cells(i, FolderID) Then  
               If MyName = .Cells(i, FileID) Then FindBool = 1  
           Else  
               MyName = Dir(PathTemp & MyPath & "\", vbDirectory)  
               Do While MyName <> ""  
                   If MyName <> "." And MyName <> ".." Then  
                       j = i - 1  
                       ErrorBool = False  
                       While MyPath = .Cells(j, FolderID) And j > 1  
                           If InStr(1, MyName, .Cells(j, FileID)) <> 0 Then ErrorBool = True  
                           j = j - 1  
                       Wend  
                       If Not ErrorBool Then  
                           .Cells(LastRow + LastNumberAdd, FolderID) = MyPath  
                           If Right(MyName, 4) = ".pdf" Or Right(MyName, 4) = ".jpg" Then  
                               If InStr(1, MyName, "îò") <> 0 And DateID <> 0 Then  
                                   .Cells(LastRow + LastNumberAdd, FileID) = Left(MyName, InStr(1, MyName, "îò") - 1)  
                                   .Cells(LastRow + LastNumberAdd, DateID) = Left(Right(MyName, Len(MyName) - InStr(1, MyName, "îò") - 2), Len(Right(MyName, Len(MyName) - InStr(1, MyName, "îò") - 2)) - 4)  
                               Else  
                                   .Cells(LastRow + LastNumberAdd, FileID) = Left(MyName, Len(MyName) - 4)  
                               End If  
                           Else  
                               .Cells(LastRow + LastNumberAdd, FileID) = MyName  
                           End If  
                           For j = 1 To LastCol  
                               .Cells(LastRow + LastNumberAdd, j).Interior.Color = NoteNotFound  
                           Next  
                           LastNumberAdd = LastNumberAdd + 1  
                       End If  
                   End If  
                   MyName = Dir  
               Loop  
           End If  
       End If  
         
       If i < LastRow + 1 Then  
           MyPath = .Cells(i, FolderID)  
           If FindBool = 2 Then  
   'Проверяем в постоянной папке  
               MyName = Dir(PathFull & MyPath & "\", vbDirectory)  
               Do While MyName <> ""  
                   If MyName <> "." And MyName <> ".." Then  
                       If InStr(1, MyName, .Cells(i, FileID)) <> 0 Then  
                           FindBool = 0  
                       End If  
                   End If  
                   MyName = Dir  
               Loop  
   'Если не находим ,проверяем во временной  
               If FindBool <> 0 Then  
                   MyName = Dir(PathTemp & MyPath & "\", vbDirectory)  
                   Do While MyName <> ""  
                       If MyName <> "." And MyName <> ".." Then  
                           If InStr(1, MyName, .Cells(i, FileID)) <> 0 Then  
                               FindBool = 0  
                               RemoveFileName = MyName  
                           End If  
                       End If  
                       MyName = Dir  
                   Loop  
   'Если находим во временной,то перемещаем в постоянную  
                   If FindBool = 0 Then  
                       If Dir(PathFull & MyPath & "\" & MyName) <> MyName Then  
                           Name PathTemp & MyPath & "\" & RemoveFileName As PathFull & MyPath & "\" & RemoveFileName  
                       End If  
                   End If  
               End If  
           End If  
           MyName = .Cells(i, FileID)  
             
           For j = 1 To LastCol  
               Select Case FindBool  
               Case 0: .Cells(i, j).Interior.Color = RGB(255, 255, 255)  
               Case 1: .Cells(i, j).Interior.Color = DoubleNote  
               Case 2: .Cells(i, j).Interior.Color = FileNotFound  
               End Select  
           Next  
       End If  
   Next  
 
End With  
 
End Sub

Всем добрый день.Проблема такая.Есть список,сбоку списка я сделал примечание,рисунок показываеться,но проблема в том!Я отсылаю список другим людям,они могут вытащить из примечания этот рисунок и сохранить у себя на компьютере,просто отправить кратинки не могу?если могут,как это делаеться?

Добрый день...У меня появилась проблема.Есть таблица,но к каждой строчке нужно прикрепить рисунок,что бы клиенты видели отчетливо.Я знаю,что это делаеться с помощью макроса,но как?Подскажите,всю голову сломал уже!