Войти
X
X

Меню

Исполнители

Гарантии качества

    Лучшие авторы
    со всего интернета

    Более 1 000 положительных отзывов

    Мы поможем вам,
    Или вернем деньги

C форума

  • Поздравим всех!
  • С наступающим Новым Годом !
  • С 8 МАРТА МИЛЫХ ЖЕНЩИН!!!
  • Как вы относитесь к help-s.ru ?
  • Посмотрим, посмеёмся! ;)
  • Помочь с самоваром.
  • Electronics Workbench 5.12
  • WebMoney или YAndex
  • Объявления и Уведомления
  • Крик души

Поиск  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
VBA, макросы - полезное и интересное, Сюда помещаем интересные и полезные программы, написанные на VBA
 
Не буду скрывать, VBA - мой любимый язык программирования. Сюда я хочу поместить некоторые из своих программ. Буду рада, если кто-нибудь меня поддержит и добавит сюда что-то интересное, написанное на VBA.
 
Иногда приходится копировать информацию из сайта и вставлять ее в Excel. На первый взгляд, нет ничего сложного в этих нехитрых действиях – копирование – переход в Excel, поиск свободной ячейки, вставка данных. Но когда эти действия приходится совершать несколько десятков а то и сотни раз – это немного утомляет и даже раздражает. И очень хочется свести к минимуму количество действий в этой несложной схеме.
А именно, чтобы при нажатии стандартного сочетания клавиш Ctrl + C — скопированное значение само помещалось в нужный файл в нужную ячейку.
Для реализации данной задачи напишем процедуру ClipboardShow, которая проверяет содержимое буфера обмена каждую секунду, и если оно отличалось от предыдущего значения, то заносится в файл в ячейку, следующую за последней заполненной.
Код
Dim Clipboard As New DataObject
Global text0 As Variant
Sub ClipboardShow()
    Application.OnTime Now + TimeValue("00:00:01"), "ClipboardShow"
    Dim myRange As Range
    Dim text1 As Variant
    On Error Resume Next
        ' Чтобы считать текст из буфера обмена
        Clipboard.GetFromClipboard
        text1 = Clipboard.GetText
        If text0 <> text1 And text1 <> "" Then
            text0 = text1
        ' ищем подходящую ячейку
            Set myRange = ThisWorkbook.Worksheets(1).Range("A1:J50")
            pusto = ""
            Set rng = myRange.Find(What:=pusto, LookIn:=xlValues, SearchOrder:=xlByColumns)
            If Not (rng Is Nothing) Then
                r = rng.Row
                c = rng.Column
                ThisWorkbook.Worksheets(1).Cells(r, c) = text0
                Clipboard.SetText ""
                Clipboard.PutInClipboard
            Else
                MsgBox "Пустых ячеек в диапазоне больше нет": Call ClipboardStop: Exit Sub
            End If
        End If
End Sub
'процедура остановки работы макроса
Sub ClipboardStop()
On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "ClipboardShow", , False
End Sub

Теперь скопированное значение из буфера обмена будет вставляться последовательно ячейка за ячейкой в нужный диапазон.
В нашем примере этот диапазон содержит 50 строк и 10 столбцов («A1:J50»).
Думаю, данная процедура облегчит жизнь тем, кому приходится собирать различную информацию из сайтов или других программ. Нет необходимости прыгать из программы в программу, из всех действий оставим только копирование, все остальное макрос сделает сам.

Примечание: для работы с буфером обмена должна быть установлена ссылка на библиотеку Microsoft Forms 2.0 Object Library
 
Цитата
>alyon_ka пишет:
хочу поместить некоторые из своих программ
Вот спасибо! Тема - супер!
 
Мы всем отделом (я и мой начальник) решали кроссворды СУДОКУ ежедневно. Без этого рабочий день не начинался. Выпив чашку чая (или кофе) с шоколадкой и разгадав кроссворд мы приступали к выполнению служебных обязанностей. Тогда и возникла идея написать макрос по генерированию таких кроссвордов. Мое увлечение кроссвордами прошло, а макрос остался.

Скачать можно здесь http://help-s.ru/library/detail.php?ID=756899
 
Ален, а что-нибудь для визуализации данных, красивое?
 
Ничего красивого я пока не придумала - все "приземленное". Но идея хорошая - надо будет подумать.
 
Цитата
>alyon_ka пишет:
Ничего красивого я пока не придумала
Я просто так выразилась, мне все интересно. :D
 
А этот макрос меня попросила написать подруга, у нее были сделаны презентации с животными, насекомыми и т.д., она показывала их своему малышу, а потом просила его назвать то или иное животное. И т.к. малыш быстро выучил в какой последовательности идут картинки одна за другой - он называл маме животных даже не глядя в экран. Вот мама и решила усложнить ему задачу, попросив меня написать макрос который бы выдавал слайды в случайном порядке. Макрос называется mixer - есть кнопка на панели инструментов либо же можно запустить Сервис - Макрос - Макросы - mixer.
Если макросы не работают - значит уровень безопасности - "высокий", нужно выставить "средний" и снова открыть макрос.
Скачать можно здесь
http://help-s.ru/library/detail.php?ID=758294
 
Цитата
>alyon_ka пишет:
Макрос называется mixer
спасибо! Мы тоже презентациями такими пользуемся
 
Выкладывать не буду, но по роли своей деятельности пришлось одно время заниматься оформлением договоров для обучения. Так как исходник бланка был изначально в Word, переделала его под Excel. Затем столкнулись с тем, что одни и те же люди приходили учиться разным дисциплинам (дело было на курсах). Тогда с помощью VBA создала пару кнопочек с формами: одна вызывается для оформления с нуля, а вторая выбирает данные из так называемой базы. Работа упростилась в несколько раз
 
чуть попозже выложу макрос как раз на эту тему - тем кому приходится иметь дело с договорами и другими различными документами в Word - очень простое и универсальное решение
 
Читал, читал эту тему... нифига ничего не понял про эти макросы. :nenado: Поискал информацию в сети... там такая "абра-кадабра" :evil:
Это так сложно или я такой тупица :?:
 
А теперь обещанный макрос. К примеру у Вас есть база клиентов в Экселе, нужно для всех клиентов составить договора. Шаблон договора в Ворде. Если подставлять нужные значения из Экселя в Ворд простым копированием - это утомительно, особенно если таких договоров пару сотен, да и ошибок при таком способе не избежать.

Вот пример простого и универсального макроса.
Код
Sub Generator()
Dim ObWord As Word.Application
Dim objDoc As Word.Document
Dim file As String
Set ob1 = ActiveWorkbook.ActiveSheet ' теперь переменная ob1 будет содержать ссылку на текущий лист активной книги
f_r = Selection.Row ' определяем номер выбранной строки
stb = Selection.Column ' определяем номер выбранного столбца
f_c = Selection.CurrentRegion.Columns(Selection.CurrentRegion.Columns.Count).Column ' определяем номер последнего столбца в данной таблице
path_f = ThisWorkbook.Path 'определяем текущую папку
file = Application.GetOpenFilename("Excel Files (*.docx;*.doc), *docx;*.doc") ' открывается диалоговое окно "Открытие документа"
If Dir(file) = Empty Then
    Exit Sub
Else
' запускаем Word, открываем выбранный документ
Set ObjWord = CreateObject("Word.Application")
    With ObjWord
        .Visible = True
        .Documents.Open Filename:=file
        Set objDoc = .ActiveDocument
    End With
With objDoc.Range
For j = 1 To f_c ' цикл по всем столбцам таблицы
    isk_zn = ob1.Cells(1, j) 'искомое значение - находится в первой строке нашей таблицы
    zamen_zn = ob1.Cells(f_r, j) 'значение для замены
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    'осуществляем замену
    With .Find
        .Text = isk_zn
        .Replacement.Text = zamen_zn
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    .Find.Execute Replace:=wdReplaceAll
Next j
' сохраняем документ в том же месте что и книга с макросом, имя документа - значение из выделенной ячейки
FName = ob1.Cells(f_r, stb)
objDoc.SaveAs Filename:=path_f & "\" & FName
    objDoc.Close
    ObjWord.Quit
End With
Set objDoc = Nothing
Set ObjWord = Nothing
ob1.Activate
End If
End Sub


Для его работы нужно подготовить шаблон вордовского документа, а в шапке таблицы Эксель названия полей взять в скобки, можно квадратные, можно фигурные, делается это для того, чтобы макрос не сделал "ненужную замену".
К примеру наша база данных выглядит так:

Тогда вордовский документ должен выглядеть так

Выбираем любую строку и запускаем макрос.
К примеру если на момент запуска макроса была выделена ячейка С3, т.е. "ЧП Новичок", то результат будет следующим

Для работы макроса нужно чтобы была установлена ссылка на библиотеку Microsoft Word 11.0 Object Library
Изменено: alyon_ka - 29.08.2011 00:18:21
 
Ален ,выложи, плиз в библиотеку. А то вдруг ту со временем потеряется. :up: Спасибо большое!
Изменено: Ressi - 29.08.2011 02:03:18
 
Цитата
>Sergei_fizik пишет:
так сложно или я такой тупица
Не тупица, это и есть программирование под знакомые Вам офисные программы. ;-)
Изменено: Ressi - 29.08.2011 02:01:50
Страницы: 1 2 След.
Читают тему (гостей: 1)


Случайное стихотворение

Радикальные рассуждения переучившегося студента
В дни скорби и сомнений, тяжёлой подготовки к экзаменам и зачётам ко всем нам приходят мысли о том, что ученье - далеко не свет! Если только свет в конце тоннеля...

«Все говорят, ученье – свет,
Но я не верю в этот бред,
Пустые сказки моралистов,
Самодовольных мазохистов.
Они наедине с собою,
Быть может, свет считают тьмою
И под прикрытьем длинной ночи
Свершают ритуально порчу.
Даю торжественную клятву:
Спалю труды по сопромату,
Чтоб семя светлое померкло,
Историю отправлю в пекло
И лишь тогда вздохну всей грудью,
Когда экзаменов не будет.
А от бессонницы избавлюсь,
Когда с литературой справлюсь.
Я докажу, ученье – тьма,
И подтвержу свои слова
Примерами несчастных братьев,
Друзей по этому несчастью,
Загубленных, невинных душ,
Отдавших жизнь за эту чушь.
Они оставили отныне
Свои открытья медицине
И остальной тупой брехне,
Во благо всем, во вред себе».
Так рассуждал я в сотый раз,
Когда как червь в земле погряз -
В рутинной подготовке в госам
По многим каверзным вопросам…
Всем этим строчкам я не рад,
Позвольте взять слова назад!
Пора бы мне конспект учить
И, наконец-то, бросить пить…
Оставить комментарий

 
 
 

Горящие заказы

Новые отзывы

  • vladi_79 Спасибо за досрочную разблокировку!  
  • e-wolfy Большое спасибо за проделанную работу!  
  • Catran Отличный исполнитель! Ответственный, корректный, помог с достаточно сложным заданием! Рекомендую!!!!  
  • nwtu11 Спасибо за выполнение работы по Электронике  
  • wroni спасибо за работы! оперативно выполнили  
  • _Любовь_ Благодарю за качественное выполнение заказа, буду рад работать с Вами еще!  
  • _Любовь_ Спасибо, Любовь за прекраснейший доклад, оригинальность доклада 84%. Надеюсь, преподаватель почитает эту отличную работу. Рекомендую!!!  
  • Dmitry Ответственный заказчик, всегда четкая постановка задачи, оперативное решение сопутствующих вопросов. Досрочная разблокировка платежа.  
  • Palych59 Работы выполнены ранее установленного срока. К качеству претензий нет. Работы все приняты  
  • bushka Работы выполняются вовремя. Качество - работы выполнены без замечаний  
  • Новые отзывы