Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Autosize comments
 
#1
02.11.2011 17:27:02
Добрый день.  
Возникла необходимость в экселевский файл добавлять фото.  
Стал рыть просторы интернета.Узнал много нового про Excel)) нашел код который мне подходит,единственное чего не хватает,так это чтобы фотки в комментариях изменялись в зависимости от дефолтного размера.  
при добавлении строки    
.Comment.Shape.TextFrame.AutoSize = True  
картинка из маленькой становится совсем малюсенькой.  
Подскажите пожалуйста как включить AutoSize.  
Заранее благодарен!  
 
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
 
 
#2
02.11.2011 18:37:35
{quote}<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>{/post}{/quote}  
 
http://turbobit.net/jacplm3gqzh4.html
 
 
 
#3
02.11.2011 20:07:53
пытался добавлять различные варианты найденные в сети,но итог к сожалению один и тот же,картинка становится очень маленькой.  
также получился вариант с установкой фиксированных размеров,но фотки разные и вертикальные и горизонтальные.поэтому получаются сплющенно-растянутыми((  
чувствую что хожу где то рядом,никто не подскажет как ? ))
 
 
 
#4
02.11.2011 20:38:12
в 2010 экселе AutoSize работает? ответьте кто нибудь пожалуйста
 
 
 
#5
02.11.2011 22:14:56
попробовал скрипт в 2003 экселе - то же самое.неужели никто не сталкивался с такой проблемой?
 
 
 
#6
02.11.2011 22:47:57
Я так думаю, что Вам нужно выложить ЗДЕСЬ НЕБОЛЬШОЙ файл-пример (xls) - кому захочется бегать по ссылкам и скачивать. Да ещё с вводом контрольных символов, ожиданием...    
Есть подозрение, что Вам нужно "Сохранять пропорции рисунка", а не Автосайз.
 
 
 
#7
03.11.2011 19:58:25
Вы правы Юрий)) выкладываю файлик.  
в автосайзе тут дело или нет,затрудняюсь определить))пытался прописывать коды с LockAspectRatio - тоже особых результатов не дало.  
 
добавление изображений по Ctrl+q  
в конце кода закомментированы три строки.если убрать комментарии в строке с Autosize,картинка становится совсем маленькой,остальные две для заданного значения изображения))  
 
буду премного благодарен решившему этот маленький пазл))
 
 
 
#8
03.11.2011 20:18:13
AutoSize - подбирает размер примечания по ТЕКСТУ в самом примечании. Для проверки добавьте такую строку:  
.Comment.Text Text:="Проверка размера примечания" & Chr(10) & ""  
И включите строку .Comment.Shape.TextFrame.AutoSize = True
 
 
 
#9
03.11.2011 20:32:18
И опять Вы правы,Юрий))автосайз с текстом работает.  
я вчера тоже нашел какой то код,там размер окна авторесайзился без проблем.а с фоткой в комментах не хочет.как же поступить в этой ситуации,чтобы заставить менять размеры коммента в зависимости от размера изображения?
 
 
 
#10
03.11.2011 20:43:42
Полагаю, что нужно предварительно узнать размер изображения :-)
 
 
 
#11
03.11.2011 20:52:50
проблема в том что они разного размера (: если бы размер был фиксированный я бы прописал разок ручками и не озадачивался.  
может тыкнете пальцем куда рыть,я в тупике (((
 
 
 
#12
03.11.2011 20:57:23
Я о том, что нужно узнавать размер каждой конкретной картинки перед вставкой. Готового решения у меня нет, а ткнуть - пожалуйста: поиск по Форуму/в Интернете :-)
 
 
 
#13
03.11.2011 21:39:48
{quote}{login=Юрий М}{date=03.11.2011 08:57}{thema=}{post}Я о том, что нужно узнавать размер каждой конкретной картинки перед вставкой. Готового решения у меня нет, а ткнуть - пожалуйста: поиск по Форуму/в Интернете :-){/post}{/quote}  
поиск и так рвется))  
я думал,что это делается кодом типа этого  
 
'Add Picture to Cell Comment Box  
   With cmt  
       .Text Text:=""  
       Set pict = stdole.LoadPicture(c.Value)  
       .Shape.Fill.UserPicture strPic & c.Value  
       On Error Resume Next  
       .ShapeRange.LockAspectRatio = msoFalse  
       .Shape.Shadow.Visible = msoFalse  
       .Shape.Width = pict.Width * zoom / 10000  
       .Shape.Height = pict.Height * zoom / 10000  
       .Visible = False  
 
еще наковырял файл вместе с надстройкой,но там очень заморочено,события разнесены по кнопкам,в общем мозга не хватает интегрировать код оттуда в свой файл :(  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
 
 
#14
03.11.2011 21:56:09
мне кажется в этом коде собака порыта.  
 
{quote}Sub InsertPhotoEx(ByVal PicturePath As String, ByRef cell As Range)  
   On Error Resume Next  
   dh = 2    ' îòñòóï îò êðà¸â ÿ÷åéêè  
   Const k = 26.46  
   If F.CheckBox_Comments Then    ' êàðòèíêè â ïðèìå÷àíèÿ  
       cell.Comment.Delete  
       Set pic = LoadPicture(PicturePath)  
       With cell.AddComment.Shape  
           w = pic.Width / k: h = pic.Height / k  
           picRatio = w / h  
           settingRatio = F.SpinButton_WComm / F.SpinButton_Hcomm  
 
           If picRatio >= settingRatio Then    ' êàðòèíêà øèðå, ÷åì ïðèìå÷àíèå  
               h = h / w * F.SpinButton_WComm  
               w = F.SpinButton_WComm  
           Else ' êàðòèêà óæå, ÷åì ïðèìå÷àíèå  
               w = w / h * F.SpinButton_Hcomm  
               h = F.SpinButton_Hcomm  
           End If  
 
           .Fill.UserPicture PicturePath ' âñòàâëÿåì êàðòèíêó  
           .Width = w  
           .Height = h  
       End With  
       Exit Sub  
   End If  
 
   On Error Resume Next: Dim sha As Shape  
   Set sha = cell.Worksheet.Shapes.AddPicture(PicturePath, True, True, cell.Left + dh, cell.Top + dh, cell.Width - 2 * dh, cell.Height - 2 * dh)  
 
   If F.CheckBox_LockAspectRatio Then  
       sha.ScaleWidth 1, msoTrue  
       sha.ScaleHeight 1, msoTrue  
   End If  
 
   With sha  
       .LockAspectRatio = msoTrue  
       .Top = cell.Top + dh  
       w = .Width: h = .Height: .Height = cell.Height - 2 * dh  
       .Width = w * .Height / h  
       .Left = cell.Left + cell.Width / 2 - .Width / 2  
   End With  
 
   If F.CheckBox_AddHyperlinks Then cell.Worksheet.Hyperlinks.Add sha, PicturePath, "", _  
      "Ùåëêíèòå äëÿ ïðîñìîòðà" & vbLf & "îðèãèíàëüíîãî èçîáðàæåíèÿ"  
End Sub{/quote}
 
 
 
#15
03.11.2011 21:56:43
Sub InsertPhotoEx(ByVal PicturePath As String, ByRef cell As Range)  
   On Error Resume Next  
   dh = 2    ' îòñòóï îò êðà¸â ÿ÷åéêè  
   Const k = 26.46  
   If F.CheckBox_Comments Then    ' êàðòèíêè â ïðèìå÷àíèÿ  
       cell.Comment.Delete  
       Set pic = LoadPicture(PicturePath)  
       With cell.AddComment.Shape  
           w = pic.Width / k: h = pic.Height / k  
           picRatio = w / h  
           settingRatio = F.SpinButton_WComm / F.SpinButton_Hcomm  
 
           If picRatio >= settingRatio Then    ' êàðòèíêà øèðå, ÷åì ïðèìå÷àíèå  
               h = h / w * F.SpinButton_WComm  
               w = F.SpinButton_WComm  
           Else ' êàðòèêà óæå, ÷åì ïðèìå÷àíèå  
               w = w / h * F.SpinButton_Hcomm  
               h = F.SpinButton_Hcomm  
           End If  
 
           .Fill.UserPicture PicturePath ' âñòàâëÿåì êàðòèíêó  
           .Width = w  
           .Height = h  
       End With  
       Exit Sub  
   End If  
 
   On Error Resume Next: Dim sha As Shape  
   Set sha = cell.Worksheet.Shapes.AddPicture(PicturePath, True, True, cell.Left + dh, cell.Top + dh, cell.Width - 2 * dh, cell.Height - 2 * dh)  
 
   If F.CheckBox_LockAspectRatio Then  
       sha.ScaleWidth 1, msoTrue  
       sha.ScaleHeight 1, msoTrue  
   End If  
 
   With sha  
       .LockAspectRatio = msoTrue  
       .Top = cell.Top + dh  
       w = .Width: h = .Height: .Height = cell.Height - 2 * dh  
       .Width = w * .Height / h  
       .Left = cell.Left + cell.Width / 2 - .Width / 2  
   End With  
 
   If F.CheckBox_AddHyperlinks Then cell.Worksheet.Hyperlinks.Add sha, PicturePath, "", _  
      "Ùåëêíèòå äëÿ ïðîñìîòðà" & vbLf & "îðèãèíàëüíîãî èçîáðàæåíèÿ"  
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх