Нашла в Инете, как автоматически проставлять дату. Но вместе с датой вставляется и время. Возможно ли убрать время, а оставить только дату?
Описание:
Quote
Предположим, у нас имеется таблица заказов, куда пользователь вводит номер заказа, имя клиента, сумму и т.д. Необходимо сделать так, чтобы при внесении номера заказа в столбец А - в столбце B напротив введенного заказа автоматически появлялись дата и время его занесения. Для этого щелкните правой кнопкой мыши по ярлычку листа с таблицей и выберите в контекстном меню Исходный текст. В открывшееся окно редактора Visual Basic скопируйте этот текст:
Quote
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A2:A100")) Is Nothing Then With Target(1, 2) .Value = Now .EntireColumn.AutoFit End With End If End Sub
При необходимости измените "чувствительный" диапазон "А2:А100" на свой собственный. Если необходимо вставлять дату не в соседний столбец, то подставьте в оператор Target(1,2) вместо двойки число побольше. Закройте редактор Visual Basic и попробуйте ввести что-нибудь в диапазон А2:А100. В соседней ячейке тут же появится текущая дата-время!
Нашла в Инете, как автоматически проставлять дату. Но вместе с датой вставляется и время. Возможно ли убрать время, а оставить только дату?
Описание:
Quote
Предположим, у нас имеется таблица заказов, куда пользователь вводит номер заказа, имя клиента, сумму и т.д. Необходимо сделать так, чтобы при внесении номера заказа в столбец А - в столбце B напротив введенного заказа автоматически появлялись дата и время его занесения. Для этого щелкните правой кнопкой мыши по ярлычку листа с таблицей и выберите в контекстном меню Исходный текст. В открывшееся окно редактора Visual Basic скопируйте этот текст:
Quote
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A2:A100")) Is Nothing Then With Target(1, 2) .Value = Now .EntireColumn.AutoFit End With End If End Sub
При необходимости измените "чувствительный" диапазон "А2:А100" на свой собственный. Если необходимо вставлять дату не в соседний столбец, то подставьте в оператор Target(1,2) вместо двойки число побольше. Закройте редактор Visual Basic и попробуйте ввести что-нибудь в диапазон А2:А100. В соседней ячейке тут же появится текущая дата-время!
Но вместе с датой вставляется и время. Возможно ли убрать время, а оставить только дату?
Возможно. Замените Now на Date.
На заметку: вручную, без макросов текущую дату (только дату) в ячейку можно вставить клавиатурной комбинацией Ctrl+; , a только время - Shift+Ctrl+; . Вставить в одну ячейку и дату, и время можно, применив обе комбинации через пробел, причем в любом порядке.
Quote (elpotap)
Но вместе с датой вставляется и время. Возможно ли убрать время, а оставить только дату?
Возможно. Замените Now на Date.
На заметку: вручную, без макросов текущую дату (только дату) в ячейку можно вставить клавиатурной комбинацией Ctrl+; , a только время - Shift+Ctrl+; . Вставить в одну ячейку и дату, и время можно, применив обе комбинации через пробел, причем в любом порядке.Gustav
Добрый день. Стоит такая задача. Есть таблица из 7 столбцов. Когда в столбец A вносят данные, в столбце E проставляется соответсвующее время. Когда в столбец F заносят данные, в столбец g заносится свое время. Вот такой код у меня:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim cc As Range Application.ScreenUpdating = False Application.EnableEvents = False
For Each cc In Target If Not Intersect(cc, Range("A2:A100000")) Is Nothing Then With cc(1, 5) .Value = IIf(Trim(cc) = "", "", Now) End With End If Next
For Each cc In Target If Not Intersect(cc, Range("F2:F100000")) Is Nothing Then With cc(1, 2) .Value = IIf(Trim(cc) = "", "", Now)
1. Необходимо чтобы при удалении и повторном внесении данных в столбцы A и F время не корректировалось. Оставалось такое же как при первом внесении. 2. Проблема, что пароль на редактирование столбцов А-D имеет один сотрудник, от столбца F - другой сотрудник, а на столбцах E и G - пароль админа. При таких наворотах макрос отказывается работать. Как бы это исправить, подскажите пожалуйста. Заранее спасибо.
Добрый день. Стоит такая задача. Есть таблица из 7 столбцов. Когда в столбец A вносят данные, в столбце E проставляется соответсвующее время. Когда в столбец F заносят данные, в столбец g заносится свое время. Вот такой код у меня:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim cc As Range Application.ScreenUpdating = False Application.EnableEvents = False
For Each cc In Target If Not Intersect(cc, Range("A2:A100000")) Is Nothing Then With cc(1, 5) .Value = IIf(Trim(cc) = "", "", Now) End With End If Next
For Each cc In Target If Not Intersect(cc, Range("F2:F100000")) Is Nothing Then With cc(1, 2) .Value = IIf(Trim(cc) = "", "", Now)
1. Необходимо чтобы при удалении и повторном внесении данных в столбцы A и F время не корректировалось. Оставалось такое же как при первом внесении. 2. Проблема, что пароль на редактирование столбцов А-D имеет один сотрудник, от столбца F - другой сотрудник, а на столбцах E и G - пароль админа. При таких наворотах макрос отказывается работать. Как бы это исправить, подскажите пожалуйста. Заранее спасибо.Immortalist
Зачем там у Вас цикл по ячейкам Target'a я не понял... Попробуйте так:[vba]
Code
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A:A")) Is Nothing Then With Target.Offset(0, 4) .Value = IIf(IsDate(.Value), .Value, Now) End With End If If Not Intersect(Target, Range("F:F")) Is Nothing Then With Target.Offset(0, 1) .Value = IIf(IsDate(.Value), .Value, Now) End With End If End Sub
[/vba]
Зачем там у Вас цикл по ячейкам Target'a я не понял... Попробуйте так:[vba]
Code
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A:A")) Is Nothing Then With Target.Offset(0, 4) .Value = IIf(IsDate(.Value), .Value, Now) End With End If If Not Intersect(Target, Range("F:F")) Is Nothing Then With Target.Offset(0, 1) .Value = IIf(IsDate(.Value), .Value, Now) End With End If End Sub
Большое спасибо за Ваши! Код отредактировал - первая проблема решилась! А вот с защитой листов проблема осталась. Все так же при попытке занести данные ругается Run-time error '1004': Aplication-defined or object-defined error. Возможно ли найти какое-то решение?
Заранее прошу прощения, плохо знаю Visual Basic...
Большое спасибо за Ваши! Код отредактировал - первая проблема решилась! А вот с защитой листов проблема осталась. Все так же при попытке занести данные ругается Run-time error '1004': Aplication-defined or object-defined error. Возможно ли найти какое-то решение?
Заранее прошу прощения, плохо знаю Visual Basic...Immortalist
А как Вы вообще умудрились дать разные права доступа к разным диапазонам листа разным пользователям? В Excel-2003 с управлением правами доступа было плохо. Как в 2007/2010 - не знаю (не люблю я их и потому практически не юзаю из-за долбанутого риббон-интерфейса, который настроить под себя очень трудно)
А как Вы вообще умудрились дать разные права доступа к разным диапазонам листа разным пользователям? В Excel-2003 с управлением правами доступа было плохо. Как в 2007/2010 - не знаю (не люблю я их и потому практически не юзаю из-за долбанутого риббон-интерфейса, который настроить под себя очень трудно)Alex_ST
В том и дело, что на работе 2010 офис, а там с этим проблем нет. Рецензирование - Разрешение изменений диапазонов - Впринципе готово. =)) В открывшемся окне просто создаем правила из серии название правила, пароль, диапазон. После того как все правила прописаны включаем защиту листа и все готово. Определенный диапазон под определенным паролем. =))
В том и дело, что на работе 2010 офис, а там с этим проблем нет. Рецензирование - Разрешение изменений диапазонов - Впринципе готово. =)) В открывшемся окне просто создаем правила из серии название правила, пароль, диапазон. После того как все правила прописаны включаем защиту листа и все готово. Определенный диапазон под определенным паролем. =))Immortalist
К стати, а как Вы идентифицируете юзеров? Если по имени пользователя Офиса, так его элементарно просто и быстро поменять. А вот если у Вас пользователи - во внутренней сети, то можно идентифицировать по сетевым именам, которые так просто уже не изменишь. Вот Вам на всякий случай презент:[vba]
Code
Function Net_UserName$() Net_UserName = CreateObject("Wscript.Network").UserName End Function
[/vba] Тогда можно по этим именам при открытии файла программно запрещать редактировать на листах всё кроме разрешённых пользователю ячеек.
К стати, а как Вы идентифицируете юзеров? Если по имени пользователя Офиса, так его элементарно просто и быстро поменять. А вот если у Вас пользователи - во внутренней сети, то можно идентифицировать по сетевым именам, которые так просто уже не изменишь. Вот Вам на всякий случай презент:[vba]
Code
Function Net_UserName$() Net_UserName = CreateObject("Wscript.Network").UserName End Function
[/vba] Тогда можно по этим именам при открытии файла программно запрещать редактировать на листах всё кроме разрешённых пользователю ячеек.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Вторник, 21.08.2012, 16:05
В общем, моё предложение такое. Таймштамп пишется в колонки E и G на Лист3, который скрыт c Visible = xlSheetVeryHidden, чтобы юзера его не увидели (доступ к проекту VBA закрыт паролем: 123).
На основном Листе1 в колонки E и G помещены формулы, выводящие значения из аналогичных ячеек Листа3: =ЕСЛИ(ЕПУСТО(Лист3!E1 );"";Лист3!E1). При желании формулы можно скрыть (признаться, запамятовал, как это делается), чтобы от Листа3 не было никаких явных следов на Листе1.
Коду придал следующий вид: [vba]
Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cc As Range
For Each cc In Target
If Not Intersect(Target, Range("A:A")) Is Nothing Then With [Лист3].Cells(cc.Row, cc.Column).Offset(0, 4) If IsEmpty(.Value) And Not IsEmpty(cc.Value) Then .Value = Now End If End With End If
If Not Intersect(Target, Range("F:F")) Is Nothing Then With [Лист3].Cells(cc.Row, cc.Column).Offset(0, 1) If IsEmpty(.Value) And Not IsEmpty(cc.Value) Then .Value = Now End If End With End If Next
End Sub
[/vba]
P.S. "запамятовал" - освежился: Ctrl+1 \ Защита \ Скрыть формулы.
В общем, моё предложение такое. Таймштамп пишется в колонки E и G на Лист3, который скрыт c Visible = xlSheetVeryHidden, чтобы юзера его не увидели (доступ к проекту VBA закрыт паролем: 123).
На основном Листе1 в колонки E и G помещены формулы, выводящие значения из аналогичных ячеек Листа3: =ЕСЛИ(ЕПУСТО(Лист3!E1 );"";Лист3!E1). При желании формулы можно скрыть (признаться, запамятовал, как это делается), чтобы от Листа3 не было никаких явных следов на Листе1.
Коду придал следующий вид: [vba]
Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cc As Range
For Each cc In Target
If Not Intersect(Target, Range("A:A")) Is Nothing Then With [Лист3].Cells(cc.Row, cc.Column).Offset(0, 4) If IsEmpty(.Value) And Not IsEmpty(cc.Value) Then .Value = Now End If End With End If
If Not Intersect(Target, Range("F:F")) Is Nothing Then With [Лист3].Cells(cc.Row, cc.Column).Offset(0, 1) If IsEmpty(.Value) And Not IsEmpty(cc.Value) Then .Value = Now End If End With End If Next
End Sub
[/vba]
P.S. "запамятовал" - освежился: Ctrl+1 \ Защита \ Скрыть формулы.Gustav
Прошу прощения, что долго не отвечал, забегался. Огромное Вам спасибо Gustav, просто то что нужно было!!!! Немного подредактировал под себя, получилось если не идеально, то очень близко к этому!!! Спасибо еще раз всем большое, если что обращусь за помощью!! Хорошего всем дня!!
Прошу прощения, что долго не отвечал, забегался. Огромное Вам спасибо Gustav, просто то что нужно было!!!! Немного подредактировал под себя, получилось если не идеально, то очень близко к этому!!! Спасибо еще раз всем большое, если что обращусь за помощью!! Хорошего всем дня!!Immortalist
Подскажите как мне решить следующий вопрос. Для автоматического добавления даты в ячейку использую следующий код (добавлен в исходный текст листа).
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:A1000000")) Is Nothing Then With Target(1, 2) .Value = Now .EntireColumn.AutoFit End With End If End Sub
[/vba]
Все работает прекрасно, но в тоже время если в столбец А просто вставить данные путем копирования (Ctrl+V) из другого файла - то в столбце В даты не отображаются, по сути добавление значений в ячейку это и есть изменение значений ?
Можно ли как-то решить данную проблему ?
Добрый день уважаемые форумчане.
Подскажите как мне решить следующий вопрос. Для автоматического добавления даты в ячейку использую следующий код (добавлен в исходный текст листа).
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:A1000000")) Is Nothing Then With Target(1, 2) .Value = Now .EntireColumn.AutoFit End With End If End Sub
[/vba]
Все работает прекрасно, но в тоже время если в столбец А просто вставить данные путем копирования (Ctrl+V) из другого файла - то в столбце В даты не отображаются, по сути добавление значений в ячейку это и есть изменение значений ?
Можно ли как-то решить данную проблему ?pinguindell
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("A1:A10000"), Target) Is Nothing Then For Each iCell In Target iCell(1, 2) = Now Next End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("A1:A10000"), Target) Is Nothing Then For Each iCell In Target iCell(1, 2) = Now Next End If End Sub
Цитата (pinguindell писал(а)): он работает даже при выключенных макросах Такого не должно быть
точно, Вы правы, просто не на ту опцию посмотрел. Действительно при выключенных макросах не работает.
А Вы не знаете можно ли назначить событие, при открытии книги, чтобы выполнялся следующий макрос, который программно снимал ограничения Excel
Источник:http://excelvba.ru/code/Security
[vba]
Код
Sub Enable_AccessVBOM_and_Macro() On Error Resume Next Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _ "\Excel\Security\"
' включаем программный доступ к объектной модели проекта VBA CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"
' ставим низкий уровень безопасности (применится после перезапуска Excel) CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD" End Sub
[/vba]
И вопрос в догонку, по коду видно что макрос создает ключ в реестре, поэтому как мне кажется будет проблема при запуске такого когда на компьютере с учетной записью обычного пользователя, а не админа ?
Цитата (AlexM)
Цитата (pinguindell писал(а)): он работает даже при выключенных макросах Такого не должно быть
точно, Вы правы, просто не на ту опцию посмотрел. Действительно при выключенных макросах не работает.
А Вы не знаете можно ли назначить событие, при открытии книги, чтобы выполнялся следующий макрос, который программно снимал ограничения Excel
Источник:http://excelvba.ru/code/Security
[vba]
Код
Sub Enable_AccessVBOM_and_Macro() On Error Resume Next Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _ "\Excel\Security\"
' включаем программный доступ к объектной модели проекта VBA CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"
' ставим низкий уровень безопасности (применится после перезапуска Excel) CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD" End Sub
[/vba]
И вопрос в догонку, по коду видно что макрос создает ключ в реестре, поэтому как мне кажется будет проблема при запуске такого когда на компьютере с учетной записью обычного пользователя, а не админа ?pinguindell
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
