Размер примечания vba excel

Leanna

Пользователь

Сообщений: 816
Регистрация: 15.01.2013

Подскажите пожалуйста как в VBA изменить размеры желтого блока примечания в ячейке A13  
и сделать его например ScaleWidth 8 и  ScaleHeight  8  
текст слишком большой, весь в блок не вмещается, а макрорекордер выдает ошибку.

Leanna

Пользователь

Сообщений: 816
Регистрация: 15.01.2013

ну и дерзайте..  

  а что там не работает я  так и не понял.  

  а если поискать, то и раньше здесь такие вопросы обсуждались

Leanna

Пользователь

Сообщений: 816
Регистрация: 15.01.2013

действительно заработало…  
за идею с .Shape.Width тебе слэн спасибо.

Изменение размера области примечания  
Макрос 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

Leanna

Пользователь

Сообщений: 816
Регистрация: 15.01.2013

Спасибо, этот вариант ещё интереснее !

olly

Пользователь

Сообщений: 6
Регистрация: 01.01.1970

Подскажите пожалуйста как в VBA изменить размер примечания с картинкой на «х» процентов.  
В прикрепленном файле на первом листе исходный вид документа, а на втором то что должно получиться.  
в программировании я «0», а файлов таких у меня 40 и в каждом от 20 до 50 строк.  
Буду Вам очень признателен!

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

olly, см. приложенный файл. Нажмите кнопку «Макрос» на листе «Начальный» <BR><STRONG>Файл удален</STRONG> — велик размер. [Модераторы]

olly

Пользователь

Сообщений: 6
Регистрация: 01.01.1970

Sombody, модераторы удалили файл!!!!!  
Скинь мне пожалуйста на мыло dubovyk_o@mail.ru  
Спасибо за помощь!!!!

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

Могу выложить только код.  
Макрос добавляет столбец 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

olly

Пользователь

Сообщений: 6
Регистрация: 01.01.1970

СПАСИБО, Sombody!  
Все работает!  
Не знаю как Вас благодарить!  
Если есть webmony могу скинуть пару $.

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

Спасибо. Это не настолько сложный макрос, чтобы я брал за него плату)

Serge

Пользователь

Сообщений: 11308
Регистрация: 01.01.1970

{quote}{login=Somebody}{date=25.04.2010 11:51}{thema=}{post}Спасибо. Это не настолько сложный макрос, чтобы я брал за него плату){/post}{/quote}А какая разница? Если человек хочет отблагодарить — пусть платит. Это для Вас несложно, а другому — выше крыши.  

  ИМХО.

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

Сергей, у меня просто нет WebMoney, ЯндексДеньги и других кошельков) Я наличность люблю )  
поэтому я просто так отмазался) не поеду же я встречаться с девушкой ради пары $$$ )

Serge

Пользователь

Сообщений: 11308
Регистрация: 01.01.1970

{quote}{login=Somebody}{date=25.04.2010 12:00}{thema=}{post}Сергей, у меня просто нет WebMoney, ЯндексДеньги и других кошельков) Я наличность люблю )  
поэтому я просто так отмазался) не поеду же я встречаться с девушкой ради пары $$$ ){/post}{/quote}Дело Ваше ;-)))  
Можно и поехать Если нет другой девушки

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

по моему опыту, на девушку уходит огромное (для меня) количество денег):  
цветы, кино, кафе (рестораны), подарки и т.д.    
В связи с этим я предполагаю, что я получу от Оли 2 доллара, а вложу 1000, мне как-то страшен такой обмен ))))))  

  P.S. Оля не принимайте это на свой счёт ) мы шутим )  

  P.P.S. Хорошо, что я пишу всё это под ником Somebody, а не под тем, под которым меня на этом форуме ОЧЕНЬ хорошо знают ))))

Serge

Пользователь

Сообщений: 11308
Регистрация: 01.01.1970

{quote}{login=Somebody}{date=25.04.2010 12:11}{thema=}{post}  
P.P.S. Хорошо, что я пишу всё это под ником Somebody, а не под тем, под которым меня на этом форуме ОЧЕНЬ хорошо знают )))){/post}{/quote}Можно в личку? Обещаю — могила.  
Просто очень интересно.

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

Serge

Пользователь

Сообщений: 11308
Регистрация: 01.01.1970

{quote}{login=Somebody}{date=25.04.2010 12:24}{thema=}{post}Написал вам на почту )){/post}{/quote}Ок

olly

Пользователь

Сообщений: 6
Регистрация: 01.01.1970

Хочу Вас расстроить:  
1. Я не девочка я мальчик  
2. Olly — меня так называли в Англии (Ирландское муж. имя)  
Вот я и взял его как ник.

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

olly )))) 5 баллов )))  

  Я вчера ещё помнил, что вы парень, вы написали в конце вашей просьбы «Буду Вам очень признателен!», а сегодня с утра я уже забыл про это и смотря на ваш ник, подумал, что девушка ))))  Прошу прощения )))

olly

Пользователь

Сообщений: 6
Регистрация: 01.01.1970

Summer!    
Вылез нюанс, в файлах попадаються фото книжного формата.  
Макрос растягивает его до альбомного.  
Можно ли изменять размер примечания пропорционально в %.

Somebody

Пользователь

Сообщений: 169
Регистрация: 01.01.1970

Олег,    
Как изменять в % соотношении я не знаю. И не знаю, как это сработает, т.к. одни фото маленькие, другие большие, т.е. одну надо уменьшить на 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  

  В коде есть комментарии «Ширина столбца» и «Высота строк», меняя эти значения можно подобрать оптимальные размеры. Попробуйте поиграться с этими цифрами

Hugo

Пользователь

Сообщений: 23257
Регистрация: 22.12.2012

Может так надо?  
Вместо 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}  
Велосипед, спасибо! То, что надо!