Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Определение ширины и высоты фотографии - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Определение ширины и высоты фотографии (Макросы/Sub)
Определение ширины и высоты фотографии
yl3d Дата: Суббота, 10.03.2018, 00:42 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 62
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте форумчане. Подскажите с решением проблемы.

Имеется код, определяющий размеры фотографии, лежащей по определенному адресу.
Структура кода такова: Имеется пользовательская функция, а затем макрос ссылающийся на эту функцию.

Как изменить этот код - чтобы не было пользовательской функции и ссылок на нее ?
Чтобы то содержимое, которое сейчас находится в теле функции - находилось в теле макроса.

Вот сам код в настоящий момент:
[vba]
Код

Function TimeFilms(ByVal sFilePath) As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim strDate$
    Dim ObjFile As Object
    
    Set ObjFile = CreateObject("Scripting.FileSystemObject").getfile(sFilePath)
    Set objFolder = CreateObject("Shell.Application").Namespace(ObjFile.parentFolder.Path)
    Set objItem = objFolder.Items.Item(ObjFile.Name)
    strDate = objFolder.GetDetailsOf(objItem, 31)
    Set objItem = Nothing: Set objFolder = Nothing: Set ObjFile = Nothing
    TimeFilms = strDate
End Function

Sub Макрос1()
    Range("F6") = (TimeFilms(Range("C2")))
End Sub
[/vba]
К сообщению приложен файл: 2313682.rar(29.3 Kb)
 
Ответить
СообщениеЗдравствуйте форумчане. Подскажите с решением проблемы.

Имеется код, определяющий размеры фотографии, лежащей по определенному адресу.
Структура кода такова: Имеется пользовательская функция, а затем макрос ссылающийся на эту функцию.

Как изменить этот код - чтобы не было пользовательской функции и ссылок на нее ?
Чтобы то содержимое, которое сейчас находится в теле функции - находилось в теле макроса.

Вот сам код в настоящий момент:
[vba]
Код

Function TimeFilms(ByVal sFilePath) As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim strDate$
    Dim ObjFile As Object
    
    Set ObjFile = CreateObject("Scripting.FileSystemObject").getfile(sFilePath)
    Set objFolder = CreateObject("Shell.Application").Namespace(ObjFile.parentFolder.Path)
    Set objItem = objFolder.Items.Item(ObjFile.Name)
    strDate = objFolder.GetDetailsOf(objItem, 31)
    Set objItem = Nothing: Set objFolder = Nothing: Set ObjFile = Nothing
    TimeFilms = strDate
End Function

Sub Макрос1()
    Range("F6") = (TimeFilms(Range("C2")))
End Sub
[/vba]

Автор - yl3d
Дата добавления - 10.03.2018 в 00:42
Pelena Дата: Суббота, 10.03.2018, 08:53 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 13299
Репутация: 2927 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Может, так?
[vba]
Код
Sub TimeFilms() As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim strDate$
    Dim ObjFile As Object
    
    Set ObjFile = CreateObject("Scripting.FileSystemObject").getfile(Range("C2").Value)
    Set objFolder = CreateObject("Shell.Application").Namespace(ObjFile.parentFolder.Path)
    Set objItem = objFolder.Items.Item(ObjFile.Name)
    strDate = objFolder.GetDetailsOf(objItem, 31)
    Set objItem = Nothing: Set objFolder = Nothing: Set ObjFile = Nothing
    Range("F6") = strDate
End Sub
[/vba]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеМожет, так?
[vba]
Код
Sub TimeFilms() As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim strDate$
    Dim ObjFile As Object
    
    Set ObjFile = CreateObject("Scripting.FileSystemObject").getfile(Range("C2").Value)
    Set objFolder = CreateObject("Shell.Application").Namespace(ObjFile.parentFolder.Path)
    Set objItem = objFolder.Items.Item(ObjFile.Name)
    strDate = objFolder.GetDetailsOf(objItem, 31)
    Set objItem = Nothing: Set objFolder = Nothing: Set ObjFile = Nothing
    Range("F6") = strDate
End Sub
[/vba]

Автор - Pelena
Дата добавления - 10.03.2018 в 08:53
yl3d Дата: Суббота, 10.03.2018, 17:04 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 62
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Pelena, спасибо
 
Ответить
СообщениеPelena, спасибо

Автор - yl3d
Дата добавления - 10.03.2018 в 17:04
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Определение ширины и высоты фотографии (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!