Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Как проверить ошибки макроса?
 
#1
13.04.2010 13:25:17
офис 2010, есть код в листе:  
Option Explicit  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Intersect(Target, Range("E25,E27,E29,E31,E33,E35,E37,E39,E41,E43,A35,A37,A39,E52,E54,E56,E58,E60,E62,E64,E66,E68,E70,AB25,AB27,AB29,AB31,AB33,AB35,AB37,AB39,AB41,AB43,AB52,AB54,AB56,AB58,AB60,AB62,AB64,AB66,AB68,AB70")) Is Nothing Then Exit Sub  
If Target.Count > 1 Then Exit Sub  
If Target.Value = "" Then Exit Sub  
Dim iComment As Comment  
Dim sPath As String  
Dim MyPick  
 
sPath = IIf(Right(ThisWorkbook.Path, 1) = Application.PathSeparator, ThisWorkbook.Path, ThisWorkbook.Path & Application.PathSeparator)  
With Target  
.ClearComments  
Set iComment = .AddComment  
If Dir(sPath & .Value & ".jpg") = "" Then  
iComment.Text "Êàðòèíêà íå íàéäåíà!"  
Else  
iComment.Shape.Fill.UserPicture sPath & .Value & ".jpg"  
Set MyPick = LoadPicture(sPath & .Value & ".jpg")  
iComment.Shape.Width = 240  
iComment.Shape.Height = CInt(MyPick.Height / (MyPick.Width / 240))  
End If  
End With  
End Sub  
 
работал он в офисе 2003 он так: при обновлении ячеек "E25,E27,E29,E31,E33 и копировался рисунок из папки где лежит сама книга файл-рисунок с именем какое вы забьете в соответствующей ячейке.  
Поставил офис 2010, комментарии в этих ячейках "E25,E27,E29,E31,E33 перестали обновляться.    
Вопросы: как проверить код? где он не работает? Он же должен ошибку выдавать где-то? может просто какую-нибудь функцию надо включить?
 
 
 
#2
13.04.2010 16:41:22
что-то не получается ничего у меня. Не так и не так не работает. Покажите пожалуйста на примере
 
 
 
#3
13.04.2010 17:14:48
да, конечно ставлю. Выбивает в редактор на ту же строчку.  
в файле подробные скрины
 
 
 
#4
13.04.2010 17:22:13
Вероятно, вы пытаетесь изменить значение более одной ячейки, а макрос расчитан на одну.
KL
 
 
 
#5
13.04.2010 17:39:05
друзья... ну я не совсем же чайник!!!  
Объясню еще раз. У меня все работало. файл я не трогал, в код не лазил.  
Переустановил систему и установил офис 2010 beta. Разрешил все макросы, чтобы от любого имени даже анонимные работали. Изменяю данные в ОДНОЙ конечно ячейке, жму enter он вообще не шевелится, хоть бы ошибку выдавал. Может это офис кривой?  
Вот я и просил у кого может офис 2007 или 2010. Попробовать работоспособность файла у себя.
 
 
 
#6
13.04.2010 17:43:01
ну может и не совсем, но код рабочий  
 
макрос считает количество ячеек входящих в target, вычисляет что их больше одной и выходит.  
 
добавьте строчку  
Debug.print target.address куда нить в начало макроса
 
 
 
#7
13.04.2010 17:47:43
Приведенные вами скриншоты недвусмысленно указывают на то, что в изменяемой области более одной ячейки, а в этом случае макрос запрограммирован как раз на "он вообще не шевелится", т.е. "Exit Sub"
KL
 
 
 
#8
13.04.2010 18:19:33
УРА!!! я определил в чем дело.  
Адрес у меня в офисе 2003, да и в 2007, когда объединяешь ячейки в написании кодов можно использовать по адресу первой ячейки, Я так понял. А когда я перешел на 2010, то объединенные ячейки макрос воспринимает, как диапазон. Только я снял объединение, начал изменять только в одной ячейки, так все заработало.(спасибо KL - натолкнули на мысль)  
Помогите теперь как можно это решить для объединенной ячейки?
 
 
 
#9
13.04.2010 18:23:03
вставил Debug.print target.address , не помогает для объединенных ячеек
 
 
 
#10
13.04.2010 23:13:53
Может я не в теме, но F8 пошагово выполняет макрос - видно в какой строке ошибка.
 
 
 
#11
14.04.2010 09:30:51
что еще раз доказывает прописную истину что объединенные ячейки зло.
 
 
 
#12
14.04.2010 14:21:09
{quote}{login=The_Prist}{date=13.04.2010 09:36}{thema=}{post}Строка Debug.print target.address ничего в макросе не делает - она просто выводит адрес целевой ячейки в окно Immediate.    
 
Попробуйте вот эту строку  
If (Target.Count > 1 And Target.MergeCells = False) Then Exit Sub  
 
вставить вместо  
If Target.Count > 1 Then Exit Sub{/post}{/quote}  
заменил.. условие пропускает  
в след. строке пишет ошибку If Target.Value = "" Then ?? а здесь что ему не нравится.  
Объединенные ячейки точно зло. Вот только форму менять очень уж долго, подгонять  размеры и тд.    
А может другим путем пойти? Убрать все эти условия, т.е. зашел в ячейку, даже  если она пустая, не важно что там напишешь, как только она потеряла фокус, те. вышел из нее, пусть дальше макрос работает и вставляет комментарий, для меня это не критично, если даже он не найдет картинку из папки.
 
 
 
#13
14.04.2010 14:27:33
если я исключаю вот эту строку If Target.Value = "" Then Exit Sub  
то ошибка выходит в вот здесь. см.код ниже:  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Intersect(Target, Range("E25,E27,E29,E31,E33,E35")) Is Nothing Then Exit Sub  
If (Target.Count > 1 And Target.MergeCells = False) Then Exit Sub 'была такая строка If Target.Count > 1 Then Exit Sub  
               'If Target.Value = "" Then Exit Sub - эту строку исключил  
Dim iComment As Comment  
Dim sPath As String  
Dim MyPick  
sPath = IIf(Right(ThisWorkbook.Path, 1) = Application.PathSeparator, ThisWorkbook.Path, ThisWorkbook.Path & Application.PathSeparator)  
With Target  
.ClearComments  
Set iComment = .AddComment 'в этой строке теперь выдает ошибку!  
If Dir(sPath & .Value & ".jpg") = "" Then  
iComment.Text "Картинка не найдена!"  
Else  
iComment.Shape.Fill.UserPicture sPath & .Value & ".jpg"  
Set MyPick = LoadPicture(sPath & .Value & ".jpg")  
iComment.Shape.Width = 240  
iComment.Shape.Height = CInt(MyPick.Height / (MyPick.Width / 240))  
End If  
End With  
End Sub
 
 
 
#14
14.04.2010 14:38:03
!!! заработало!Спасибо всем огромное! Отдельный респект The_Prist.  
Вот такой код получился. Он работает и с объединенными ячейками:  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Intersect(Target, Range("E25,E27,E29,E31,E33,E35")) Is Nothing Then Exit Sub  
If (Target.Count > 1 And Target.MergeCells = False) Then Exit Sub  
If Target.Cells(1).Value = "" Then Exit Sub  
Dim iComment As Comment  
Dim sPath As String  
Dim MyPick  
sPath = IIf(Right(ThisWorkbook.Path, 1) = Application.PathSeparator, ThisWorkbook.Path, ThisWorkbook.Path & Application.PathSeparator)  
With Target.Cells(1)  
.ClearComments  
Set iComment = .AddComment  
If Dir(sPath & .Value & ".jpg") = "" Then  
iComment.Text "Картинка не найдена!"  
Else  
iComment.Shape.Fill.UserPicture sPath & .Value & ".jpg"  
Set MyPick = LoadPicture(sPath & .Value & ".jpg")  
iComment.Shape.Width = 240  
iComment.Shape.Height = CInt(MyPick.Height / (MyPick.Width / 240))  
End If  
End With  
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх