Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Как изменить размеры примечания програмно?
 
#1
23.05.2008 10:38:00
Подскажите пожалуйста как в VBA изменить размеры желтого блока примечания в ячейке A13  
и сделать его например ScaleWidth 8 и  ScaleHeight  8  
текст слишком большой, весь в блок не вмещается, а макрорекордер выдает ошибку.
Работать надо не 12 часов, а головой.
 
 
 
#2
23.05.2008 11:39:24
как то так:
 
 
 
#3
23.05.2008 15:16:20
спаисбо слэн,  
Только мне нужно немного другое типа, не обновление,  
мне нужно будет в код вставить  в обработку ячеек и присвоение им примечаний.  
 
Данный код .Shape.Height = h и .Shape.Width = w не работает надо что-то работающее код на примечание должен будет примерно выглядеть след образом.  
 
With Range("a11").AddComment  
   .Visible = False  
   .Text "большой текст"  
   .Shape.Width = w  
   .Shape.Height = h  
End With  
где w ширина, h - высота
Работать надо не 12 часов, а головой.
 
 
 
#4
23.05.2008 15:45:44
ну и дерзайте..  
 
а что там не работает я  так и не понял.  
 
а если поискать, то и раньше здесь такие вопросы обсуждались
 
 
 
#5
23.05.2008 16:14:36
действительно заработало...  
за идею с .Shape.Width тебе слэн спасибо.
Работать надо не 12 часов, а головой.
 
 
 
#6
23.05.2008 19:57:07
Изменение размера области примечания  
Макрос CommentFitter1 любезно предоставлен Томом Уртисом.  
Следующий макрос изменяет размер области примечания так, чтобы она  
вместила в себя весь текст примечания.  
 
Sub CommentFitter1()  
Application.ScreenUpdating = False  
Dim x As Range, y As Long  
For Each x In Cells.SpecialCells(xlCellTypeComments)  
Select Case True  
Case Len(x.NoteText) <> 0  
With x.Comment  
.Shape.TextFrame.AutoSize = True  
If .Shape.Width > 250 Then  
y = .Shape.Width * .Shape.Height  
.Shape.Width = 150  
.Shape.Height = (y / 200) * 1.2  
End If  
End With  
End Select  
Next x  
Application.ScreenUpdating = True  
End Sub
 
 
 
#7
27.05.2008 09:43:58
Спасибо, этот вариант ещё интереснее !
Работать надо не 12 часов, а головой.
 
 
 
#8
24.04.2010 23:12:35
Подскажите пожалуйста как в VBA изменить размер примечания с картинкой на "х" процентов.  
В прикрепленном файле на первом листе исходный вид документа, а на втором то что должно получиться.  
в программировании я "0", а файлов таких у меня 40 и в каждом от 20 до 50 строк.  
Буду Вам очень признателен!
 
 
 
#9
25.04.2010 00:24:14
olly, см. приложенный файл. Нажмите кнопку "Макрос" на листе "Начальный" <BR><STRONG>Файл удален</STRONG> - велик размер. [Модераторы]
 
 
 
#10
25.04.2010 10:53:49
Sombody, модераторы удалили файл!!!!!  
Скинь мне пожалуйста на мыло dubovyk_o@mail.ru  
Спасибо за помощь!!!!
 
 
 
#11
25.04.2010 11:17:18
Заархиваровал WinRAR
 
 
 
#12
25.04.2010 11:25:34
Могу выложить только код.  
Макрос добавляет столбец D, циклом проходит по ячейкам в столбце С и отображает примечания, добавленные ячейкам в столбце С и выравниваем окошко примечания, чтобы оно отображалось в столбце D  
 
Sub CorrectComments()  
Dim iLastRow As Long, iRow As Long, iComment As Comment  
 
   If MsgBox("Выравнить фото по столбцу D?", vbQuestion + vbYesNo, "Выравнивание фото") = vbNo Then Exit Sub  
   iLastRow = Cells(Rows.Count, "C").End(xlUp).Row  
   Range("D1").EntireColumn.Insert  
   Columns("D:D").ColumnWidth = 30  
   For iRow = 5 To iLastRow  
       Set iComment = Cells(iRow, "C").Comment  
       If Not iComment Is Nothing Then  
           Rows(iRow).RowHeight = 110  
           iComment.Visible = True  
           iComment.Shape.Left = Columns("D").Left  
           iComment.Shape.Top = Cells(iRow, "D").Top  
           iComment.Shape.Height = Rows(iRow).Height 'высота примечания  
           iComment.Shape.Width = Columns("D").Width 'ширина примечания  
       End If  
   Next iRow  
   Range("D4") = "Фото"  
   MsgBox "Фотографии выравнены!", 64, "Конец"  
End Sub
 
 
 
#13
25.04.2010 11:40:34
СПАСИБО, Sombody!  
Все работает!  
Не знаю как Вас благодарить!  
Если есть webmony могу скинуть пару $.
 
 
 
#14
25.04.2010 11:51:35
Спасибо. Это не настолько сложный макрос, чтобы я брал за него плату)
 
 
 
#15
25.04.2010 11:57:31
{quote}{login=Somebody}{date=25.04.2010 11:51}{thema=}{post}Спасибо. Это не настолько сложный макрос, чтобы я брал за него плату){/post}{/quote}А какая разница? Если человек хочет отблагодарить - пусть платит. Это для Вас несложно, а другому - выше крыши.  
 
ИМХО.
 
 
 
#16
25.04.2010 12:00:07
Сергей, у меня просто нет WebMoney, ЯндексДеньги и других кошельков) Я наличность люблю )  
поэтому я просто так отмазался) не поеду же я встречаться с девушкой ради пары $$$ )
 
 
 
#17
25.04.2010 12:02:20
{quote}{login=Somebody}{date=25.04.2010 12:00}{thema=}{post}Сергей, у меня просто нет WebMoney, ЯндексДеньги и других кошельков) Я наличность люблю )  
поэтому я просто так отмазался) не поеду же я встречаться с девушкой ради пары $$$ ){/post}{/quote}Дело Ваше ;-)))  
Можно и поехать :-) Если нет другой девушки :)
 
 
 
#18
25.04.2010 12:11:40
по моему опыту, на девушку уходит огромное (для меня) количество денег):  
цветы, кино, кафе (рестораны), подарки и т.д.    
В связи с этим я предполагаю, что я получу от Оли 2 доллара, а вложу 1000, мне как-то страшен такой обмен ))))))  
 
P.S. Оля не принимайте это на свой счёт ) мы шутим )  
 
P.P.S. Хорошо, что я пишу всё это под ником Somebody, а не под тем, под которым меня на этом форуме ОЧЕНЬ хорошо знают ))))
 
 
 
#19
25.04.2010 12:17:22
{quote}{login=Somebody}{date=25.04.2010 12:11}{thema=}{post}  
P.P.S. Хорошо, что я пишу всё это под ником Somebody, а не под тем, под которым меня на этом форуме ОЧЕНЬ хорошо знают )))){/post}{/quote}Можно в личку? Обещаю - могила.  
Просто очень интересно.
 
 
 
#20
25.04.2010 12:24:07
Написал вам на почту ))
 
 
 
#21
25.04.2010 12:26:41
{quote}{login=Somebody}{date=25.04.2010 12:24}{thema=}{post}Написал вам на почту )){/post}{/quote}Ок :-)
 
 
 
#22
25.04.2010 12:45:45
Хочу Вас расстроить:  
1. Я не девочка я мальчик  
2. Olly - меня так называли в Англии (Ирландское муж. имя)  
Вот я и взял его как ник.
 
 
 
#23
25.04.2010 12:52:51
olly )))) 5 баллов )))  
 
Я вчера ещё помнил, что вы парень, вы написали в конце вашей просьбы "Буду Вам очень признателен!", а сегодня с утра я уже забыл про это и смотря на ваш ник, подумал, что девушка ))))  Прошу прощения )))
 
 
 
#24
25.04.2010 13:03:00
Summer!    
Вылез нюанс, в файлах попадаються фото книжного формата.  
Макрос растягивает его до альбомного.  
Можно ли изменять размер примечания пропорционально в %.
 
 
 
#25
25.04.2010 13:43:28
Олег,    
Как изменять в % соотношении я не знаю. И не знаю, как это сработает, т.к. одни фото маленькие, другие большие, т.е. одну надо уменьшить на 10%, а другую на 50%  
 
Попробуйте этот код  
 
Sub CorrectComments()  
   Dim iLastRow As Long, iRow As Long, iComment As Comment  
 
   If MsgBox("Выравнить фото по столбцу D?", vbQuestion + vbYesNo, "Выравнивание фото") = vbNo Then Exit Sub  
   iLastRow = Cells(Rows.Count, "C").End(xlUp).Row  
   Range("D1").EntireColumn.Insert  
   Columns("D:D").ColumnWidth = 20 'ширина столбца  
   Application.ScreenUpdating = False  
   For iRow = 5 To iLastRow  
       Set iComment = Cells(iRow, "C").Comment  
       If Not iComment Is Nothing Then  
           Rows(iRow).RowHeight = 140 'высота строк  
           iComment.Visible = True  
           iComment.Shape.Left = Columns("D").Left  
           iComment.Shape.Top = Cells(iRow, "D").Top  
           iComment.Shape.Height = Rows(iRow).Height    'высота примечания  
           iComment.Shape.Width = Columns("D").Width    'ширина примечания  
       End If  
   Next iRow  
   Range("D3") = "Фото"  
   Application.ScreenUpdating = True  
   MsgBox "Фотографии выравнены!", 64, "Конец"  
End Sub  
 
В коде есть комментарии "Ширина столбца" и "Высота строк", меняя эти значения можно подобрать оптимальные размеры. Попробуйте поиграться с этими цифрами
 
 
 
#26
25.04.2010 14:11:21
Может так надо?  
Вместо 5.25 может чуть другую цифру можно поставить.  
 
Option Explicit  
 
Sub CorrectComments()  
Dim iLastRow As Long, iRow As Long, iComment As Comment  
Dim temp As Single, tempwidhth As Single  
 
If MsgBox("Выравнить фото по столбцу D?", vbQuestion + vbYesNo, "Выравнивание фото") = vbNo Then Exit Sub  
iLastRow = Cells(Rows.Count, "C").End(xlUp).Row  
Range("D1").EntireColumn.Insert  
Columns("D:D").ColumnWidth = 30  
For iRow = 5 To iLastRow  
Set iComment = Cells(iRow, "C").Comment  
If Not iComment Is Nothing Then  
Rows(iRow).RowHeight = 110  
iComment.Visible = True  
iComment.Shape.Left = Columns("D").Left  
iComment.Shape.Top = Cells(iRow, "D").Top  
temp = iComment.Shape.Width / iComment.Shape.Height  
iComment.Shape.Height = Rows(iRow).Height 'высота примечания  
iComment.Shape.Width = Rows(iRow).Height * temp 'ширина примечания  
If iComment.Shape.Width > tempwidhth Then tempwidhth = iComment.Shape.Width  
End If  
Next iRow  
Columns("D:D").ColumnWidth = tempwidhth / 5.25  
 
Range("D4") = "Фото"  
MsgBox "Фотографии выравнены!", 64, "Конец"  
End Sub
 
 
 
#27
07.06.2011 18:44:51
{quote}{login=Велосипед}{date=23.05.2008 07:57}{thema=Как изменить размеры примечания програмно?}{post}Изменение размера области примечания  
.Comment.Shape.TextFrame.AutoSize = True  
{/post}{/quote}  
Велосипед, спасибо! То, что надо!
 
 
 
Страницы: 1
Читают тему
Наверх