Войти
X
X
  • cpcv - автор студенческих работ
    cpcv ЧАТ
    Рейтинг : 3248

  • lesi555 - автор студенческих работ
    lesi555 ЧАТ
    Рейтинг : 17520

    Помощь по экономическим и гуманитарным дисциплинам

  • olga_1309 - автор студенческих работ
    olga_1309 ЧАТ
    Рейтинг : 18114

  • Svetlana_2018 - автор студенческих работ
    Svetlana_2018 ЧАТ
    Рейтинг : 1201

    Помощь по экономике, педагогике, праву и пр. дисц.

  • c264 - автор студенческих работ
    c264 ЧАТ
    Рейтинг : 3014

    Только Word

Меню

Исполнители

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

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

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

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

C форума

  • Помочь с самоваром.
  • Как вы относитесь к 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)


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

Студенческие годы - лучшие годы в жизни каждого
Каждый из нас, пожалуй, помнит свои студенческие годы. Веселые встречи, переживания во время сессий, подготовка к экзаменам, настоящая дружба, поддержка и взаимовыручка - всё это не забудется никогда...

Судьба решила - будем мы знакомы,
Все в группе нашей - дружная семья.
И универ нам стал как будто домом,
Да и преподы - вроде как родня.
Друг другу, если надо, помогаем,
И шпорой поделиться - нет проблем!
Всей группой дружно пары прогуляем,
Ну, а влетит - так тоже дружно всем!
Студенческий союз наш нерушимый,
И дружба наша - ведь не просто звук.
Готовы покорить мы все вершины,
Ведь знаем - за спиною верный друг! Оставить комментарий

 
 
 

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

Новые отзывы

  • wroni Спасибо за быструю и качественную работу!  
  • coolsolver Спасибо за качественные работы, выполненные раньше срока!  
  • e-wolfy Хочу сказать огромное СПАСИБО за выполненные заказы. Выполнение быстрое, оформление не к чему придраться!
    Всегда на связи, общение легкое и приятное!
    Замечательный исполнитель!
    А еще СПАСИБО, СПАСИБО, СПАСИБО за безвозмездную помощь в решении задач!  
  • vikand Ответственный и вежливый заказчик, который всегда войдет в положение! Очень рада сотрудничеству с ним и всем РЕКОМЕНДУЮ!!!  
  • Thumbelina Замечательный исполнитель! Великолепный человек! Всегда качество и ответственность за результат! Оперативная работа в условиях форс-мажора! Работаю с данным автором уже более 5 лет и ни разу не пожалел!!!!!! Низкий поклон!!!!  
  • coolsolver Сергей, большое спасибо за хорошую работу. :)  
  • Jagodka-K Спасибо Вам Большое за выполненные практические задачи. Рад нашему сотрудничеству.  
  • tango Спасибо Вам Большое за выполненную работу по БЖД. Рад нашему сотрудничеству.  
  • coolsolver Спасибо за качественные работы!  
  • klen Спасибо за сотрудничество!  
  • Новые отзывы
Parse error: syntax error, unexpected 'elseif' (T_ELSEIF) in /home/helps/data/www/help-s.ru/bitrix/templates/main_2016_like/footer_css.php on line 8