Темы

Здравствуйте, форумчане.

Перехожу к делу:
Имеется календарь (см. пример в приложении). Но не работает опция установки времени - устанавливает текущую дату. То есть в Textbox1  должно отображаться и выбранная дата и время. Окажите содействие. Спасибо.

Здравствуйте, формучане.

Два дня пытаюсь,  не могу разобраться. Задача в следующем:

Необходимо подсчитать количество уникальных значений в колонке A, но при этом, они должны считаться, только ,если в колонке "С", (содержащей фамилии), находится фамилия, например "Иванов".
Плюс к этому еще одно условие: поиск осуществляется в определенном диапазоне по дате (диапазон будет выбираться пользователем). В примере это ячейки: H1 и I1.
№    Дата                   Фамилия
1   01.01.2016   Иванов
1   02.01.2016   Иванов
1   03.01.2016   Иванов
5   04.01.2016   Сидоров
5   05.01.2016   Сидоров
5   06.01.2016   Сидоров
7   07.01.2016   Петров
8   08.01.2016   Петров
9   09.01.2016   Петров
10   10.01.2016   Петров
Что-то вроде этого:

Код (vb) Выделить Развернуть


=ЕСЛИ(C2:C11="Сидоров";СУММ(ЕСЛИ(ЧАСТОТА(A2:A11;A2:A11)>0;1));0)


Помогите разобраться, спасибо

Здравствуйте, форумчане.

Проблема в следующем:

Необходимо вставлять в тело письма таблицу. Использую следующий код:

Код (vb) Выделить Развернуть



Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Public Function SheetToHTML(sh As Worksheet)
Dim TempFile As String
Dim fso As Object
Dim ts As Object
Sheets("Отклоение").Visible = True
sh.Copy
TempFile = sh.Parent.Path & "\TempHtml.htm"
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
TempFile, "Отклонение", "A1:K50", xlHtmlStatic)
.Publish (True)
.AutoRepublish = False
End With
ActiveWorkbook.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
SheetToHTML = Replace(SheetToHTML, "align=center", "align=left")
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile 'сделать экспорт таблицы по средством временного файла, а затем его удалить
Sheets("Отклонение").Visible = False
End Function


Sub Отправка ()

Dim mailApp As Object
Set mailApp = CreateObject("Outlook.Application")
With mailApp.CreateItem(0)
.To = Sheets("Письмо").Range("D10")
.CC = Sheets("Письмо").Range("E10")
.Subject = Sheets("Плюс").Range("B2")
.BodyFormat = 2
.HTMLBody = SheetToHTML(ThisWorkbook.Worksheets("Отклонение"))
.Display
End With
Set mailApp = Nothing


End Sub



И все работает ОК, но как только выкладываю файл в папку общего доступа для нескольких пользователей, возникает ошибка. Создается новая книга с  нужной таблице и на этом все операции прекращаются.  Вот на этой строке возникает ошибка "File not found"

Код (vb) Выделить Развернуть

Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)


Можно ли сохранять данный временный файл в папке  "C:\Temp\" из него брать табличку и вставлять в письмо? То есть, чтобы данный временный файл сохранялся на компьютере того кто в данный момент работает с программой, а не в папке общего доступа, как он делает сейчас и вследствие чего возникает ошибка?   Подправьте, пожалуйста, что не так.  Спасибо.

Здравствуйте, форумчане
На первой станице имеется таблица с данными, которая заполняется посредством Userform. Необходимо следующее:  переносить данные по «прогульщикам» на другой лист, где по данному нарушителю сформировать таблицу с хронологий нарушений.  То есть, как только я ввожу данные по «Иванову» на Лист1 на Листе2 формируется таблица которая содержит данные из колонок «Дата», «Фамилия ученика», «Оценка», «нарушение», т.е. все что числится за данным учеником, но по критерию «прогул» в хронологическом порядке.  Таким образом, формирование таблицы результатов на Листе2 происходит при совпадении вновь введенной «Фамилии» и «Нарушения».

Варианты пробовала разные, но ни один, даже приблизительно, не  жизнеспособен. 

Подскажите, пожалуйста. Спасибо.

Здравствуйте, форумчане

Небольшая задачка.
Имеется OptionBitton на Userform. Работает автономно, то есть не связана со второй и пр. Optionbutton (не в группе). При одинарном нажатии становится в значении True. Но при повторном нажатии так и остается выделенной. Как сделать, чтобы при повторном нажатии она дезактивировалась? Спасибо.

Здравствуйте, форумчане.
Снова к вам за советом.

Задача такая: при изменении месяца - срабатывание макроса по генерации случайных чисел. Сравнение происходит следующим образом:  в ячейке В3  происходит формирование значения месяца (Например "3")  с помощью функций Сегодня()  и Месяц(). Это значение сравнивается со значением месяца в ячейке B4, если отличается тогда срабатывает макрос по генерации случайных чисел.
Но почему-то все это срабатывает только 1 раз, сразу после написания кода, а дальше при любом изменении месяца не реагирует.

Соответственно код:

Код (vb) Выделить Развернуть


Private Sub Workbook_Open()
   If Me.Sheets("Лист1").Range("B3").Value <> Me.Sheets("Лист1").Range("B4").Value Then
    Call случайныечисла
     Me.Sheets("Лист1").Range("B4").Value = Month(Now)
   Me.Save
  End If
End Sub

Подскажите, пожалуйста, в чем причина. Спасибо.
В приложении, пример.

Здравствуйте, форумчане
Небольшая проблема: в программе используется несколько Userform (Userform1,Userform2,Userform3).  Активируются соответствующим выбором из Listbox. Одним из возможных вариантов использования пользователем - открытие нескольких форм одновременно. Как можно это присечь? Грубо говоря, если открывается Userform1, то,если в этот момент оказываются открыты остальные - то они бы закрывались?  Подскажите, пожалуйста. Спасибо.

Здравствуйте, форумчане.
Столкнулась с проблемой:
Необходимо сравнить две даты, которые появляются в ячейках посредством Userformы (Textbox1  и Textbox2). По результатам сравнения срабатывает макрос. Например А1>A2. Если даты в пределах одного месяца, то вся работает ОК. Если же месяца разные и тем более года, то программа не определяет, что одна дата больше другой. Понимаю, что проблемам в формате. Но что не так  - не понимаю. Подскажите, пожалуйста. Спасибо.
(Для примера в Образце сделана функция "ЕСЛИ", которая тоже "не понимает", что дата больше).

Добрый день!
Форумчане, проблема в следующем:

Необходимо строить таблицу слева на право. Причем количество заполненных столбцов для каждой строки будет разной.
Использую код:

Код (vb) Выделить Развернуть

Private Sub CommandButton1_Click()
With Лист1
Dim lLastCol As Long
lLastCol = Cells.SpecialCells(xlLastCell).Column
    Cells(3, lLastCol + 1).Value = TextBox1.Value '
    Cells(3, lLastCol + 2).Value = TextBox2.Value '
    Cells(3, lLastCol + 3).Value = TextBox3.Value '
End With
End Sub


Но есть несколько проблем:
1. Мне необходимо, чтобы определялась последняя заполненная ячейка в конкретной строке (без учета заголовков таблицы и заполненных столбцов в других строках).
2. Стоит мне внести какое либо значение за пределами строки и потом его удалить, она все равно понимает эту ячейку как последний заполненный столбец. Срабатывает корректно только после удаления и сохранения файла.

Как можно решить такую проблему, подкажите, пожалуйста. Спасибо.

Здравствуйте, форумчане!

Проблема в следущем: сравниваются последние сроки двух диапазонов на Лист2. При сравнении, если данные не совпадают, то несовпавшее значение переносится на другой Лист38.

Код (vb) Выделить Развернуть


Sub Перенос()
Dim LastRow1 As Long, LastRow2 As Long, Rng1 As Range, Rng2 As Range, Rng3 As Range
    LastRow1 = Cells(Rows.Count, 2).End(xlUp).Row
    Set Rng1 = Sheets(2).Range(Cells(LastRow1, 2), Cells(LastRow1, 109))
    LastRow2 = Cells(Rows.Count, 114).End(xlUp).Row
    Set Rng2 = Sheets(2).Range(Cells(LastRow2, 114), Cells(LastRow2, 221))
    Set Rng3 = Sheets(38).Range("B7:DE7")
    For i = 1 To 108
    If Rng1(i) <> Rng2(i) Then
    Rng3(i).Value = Rng1(i).Value
    End If
   Next
   End Sub



На простом примере - в отдельном файле, где немного страниц - все работает. Но при переносе кода в основной файл, содержащий 40 страниц, работать отказывается. Выделяет строку:

Код (vb) Выделить Развернуть

Set Rng1 = Sheets(2).Range(Cells(LastRow1, 2), Cells(LastRow1, 109))

Подскажите, пожалуйста в чем проблема?   Спасибо.

Здравствуйте, форумчане.
Проблема такова: Заполнение данных в таблице происходит через Userform. Но очень важно, чтобы пользователь соблюдал последовательность при заполнении. То есть, при выборе данных в Combobox была соблюдена очередность (Понедельник, Вторник, Среда и т.д.). При этом он не смог бы пропустить ни одного дня недели для заполнения. Например, он пропустил "Вторник" и сразу с "Понедельника" перешел на "Среду"- выдается сообщение, что необходимо ввести данные за "Вторник" и заполнение таблицы становится невозможным. Второй момент: тоже самое, но с OptionButton1. Сначала при заполнении обязательно выбирается OptionButton1, вносятся данные, а потом OptionButton2, но не наоборот.
Скажите, пожалуйста, как можно реализовать? Спасибо.
В приложении, образец.

Здравствуйте, форумчане.
Проблема в следующем:

Пытаюсь переделать макрос для генерации случайных чисел с 1 по 35. Использую за основу вот это:

Код (vb) Выделить Развернуть

Option Explicit
Sub random()
Dim a(156), k, i, sluch As Integer
For i = -78 To 78
    If i <> 22 Then a(i + 78) = i
Next
For i = 0 To 156
    sluch = Int(Rnd() * (156))
    k = a(i): a(i) = a(sluch): a(sluch) = k
Next
'выводим готовый массив
For i = -78 To 78
    Cells(i + 79, 1) = a(i + 78)
Next
End Sub
.
Но ничего не выходит, подскажите, пожалуйста, что нужно исправить. Спасибо.

Здравствуйте,
Подскажите, пожалуйста: невозможно работать в файле при открытой Userform - все время брянькает, как подправить? Спасибо.

Здравствствуйте,
Подскажите, пожалуйста, может кто знает, как сдеалать чтобы тело письма при рассылке через аутлук формировалось из таблицы на определенной странице, причем чтобы сохранялся формат ячеек (требуется перенести в письмо ячейки с заливкой). Пробую так, но это не совсем то:

Код (vb) Выделить Развернуть




Sub Отправка()
Dim OutlookApp As Object, SM As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set SM = OutlookApp.CreateItem(olMailItem)
SM.To = Sheets(2).Range("G7") 'Кому

SM.CC = Sheets(2).Range("G8")  'Копия"
 
SM.Subject = "Тема письма"
On Error Resume Next
SM.Body = Sheets(2).Range("G6") & Range("G10") & Range("G11").Value
SM.Attachments.Add
SM.Display
Set SM = Nothing
Set OutlookApp = Nothing
End Sub



Спасибо.

Здравствуйте,
Проблема такова. Необходимо сравнить значения в последних строках двух диапазонов, находящихся на одной странице. Количество столбцов и диапазонах одинаковое. Диапазоны пополняющиеся (в первый значения вносятся вручную, во втором через Userform и оба строятся одна под другой). Если значения в ячейках совпадают, тогда совпавшая ячейка закрашивается цветом. Поиски в интернете не принесли результата. Подскажите пожалуйста, реально сделать или нет? Спасибо.

Здравствуйте,
Проблема в следующем:
Необходимо менять имя файла при сохранении, в зависимости от значений в ячейке А1. Пробую вот так

Код (vb) Выделить Развернуть


Sub Макрос1()
Dim a$
a = Cells(1, 1) 'a1 name
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\.........\ИМЯ ФАЙЛА\" & a & ".xlsm"
End Sub


Работает, но программа сохраняет файл с новым именем еще одним (дополнительным) файлом в папке, а надо чтобы она заменяла предыдущую версию.
Подкажите, пожалуйста, как можно сделать?

Здравствуйте,
Подскажите, пожалуйста, как сделать, чтобы ввод данных в техtbox был возможен только при английской раскладке клавиатуры? То есть, при вводе на русском, просто не позволяло ввести данные. Спасибо.

Здравствуйте,
Подскажите, пожалуйста, как можно сделать сохранение определенного листа файла в другой книге. Причем, предполагается сохранение один раз в конце месяца и каждый месяц тот (другой файл) должен пополниться этой, уже обновленной в течение месяца, страницей?

Спасибо.

Здравствуйте,

проблема в следующем:
пытаюсь сравнить два диапазона на Листе1 "Общий" диапазон B4:B6 и Листе18 "ОК" диапазон A1:A3. Соответственно, при равенстве - происходит заливка диапазона B4:B6 на Листе1.
Данные для Листа 1 в ячейках B4:B6  формируются формулами. Данные на лист 18"ОК" в диапазон A1:A3 вносятся через юзерформу.

Код (vb) Выделить Развернуть

If Evaluate("AND(" & Sheets("Общий").Name & "!B4:B6=" & Sheets(2).Name & "!A1:A3)") Then Sheets("Общий").Range("B4:B6").Interior.ColorIndex = 4
Но возникает ошибка:
Run-time error 13
Tipe mismatch
И до слова "then" выделяет желтым

Может тут проблема с названием листов или с порядком страниц в книге? Подскажите, пожалуйста, как можно исправить.

Здравствуйте,
Проблема такова:
1.   Макросом формируется письмо.

Код (vb) Выделить Развернуть

Sub Письмо()
Dim OutlookApp As Object, SM As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set SM = OutlookApp.CreateItem(olMailItem)
SM.To = "Кому" 'Поле "Кому"
SM.CC = "КОПИЯ" 'Поле "Копия"
SM.Subject = "Тема письма"
On Error Resume Next
SM.Body = Лист7.Range("G6").Value
SM.Display
Set SM = Nothing
Set OutlookApp = Nothing
End Sub


2.   Макрос письма запускается при открытии файла после смены текущей даты.

Код (vb) Выделить Развернуть

Private Sub Workbook_Open()
  With Me.Sheets("Лист1").Range("B2")
    If .Value <> Date Then
      Call Письмо
      .Value = Date
      End If
    End With
End Sub



Текст письма берется из ячейки G6, которая формируется в зависимости от текущей даты формулами ЕСЛИ и СЦЕПИТЬ.
Проблема в том, что текст письма формируется не для текущей даты, а почему-то, берет запись предыдущего дня. Причем если запустить макрос формирования письма через «RUN», он формирует письмо для текущей даты, как и положено.
Почему так происходит, подскажите, пожалуйста.