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

Вход

Регистрация

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

 

= Мир MS Excel/Записи участника (krosav4ig) - Мир MS Excel

Результаты поиска
krosav4ig Дата: Вторник, 13.12.2016, 16:36 | Сообщение № 981 | Тема: DB + Userform (Excel vs Access)
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
если проблема в отсутствии date picker, то можно решить ее так:
скопировать себе модули классов из файла отсюда
Прикрепление и извлечение различных файлов из книги Excel
у себя запустить
[vba]
Код
Sub ПрикрепитьФайл()    ' прикрепляем файл к книге Excel
    If IsError([SheetForAttachedFiles!A1]) Then
        With ThisWorkbook.Sheets
            With .Add(.Item(1))
                .Visible = xlVeryHidden
                .Name = "SheetForAttachedFiles"
            End With
        End With
    End If
    Dim FileManager As New AttachedFiles, res As Boolean
    res = FileManager.AttachNewFile(Environ("windir") & "\system32\mscomct2.ocx")
End Sub
[/vba]
на других компьютерах при открытии файла
[vba]
Код
Sub ИзвлечьФайл()    ' извлекаем и регистрируем
    Dim FileManager As New AttachedFiles, res As Boolean
    On Error Resume Next ' на случай, если среди вложений нет файла mscomct2.ocx
    If Dir$(Environ("windir") & "\system32\mscomct2.ocx") = "" Then _
    res = FileManager.GetAttachment("mscomct2.ocx").SaveAs(Environ("windir") & "\system32\mscomct2.ocx")
    CreateObject("wscript.shell").Run ("regsvr32.exe """ & Environ("windir") & "\system32\mscomct2.ocx" & """ /s")
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеесли проблема в отсутствии date picker, то можно решить ее так:
скопировать себе модули классов из файла отсюда
Прикрепление и извлечение различных файлов из книги Excel
у себя запустить
[vba]
Код
Sub ПрикрепитьФайл()    ' прикрепляем файл к книге Excel
    If IsError([SheetForAttachedFiles!A1]) Then
        With ThisWorkbook.Sheets
            With .Add(.Item(1))
                .Visible = xlVeryHidden
                .Name = "SheetForAttachedFiles"
            End With
        End With
    End If
    Dim FileManager As New AttachedFiles, res As Boolean
    res = FileManager.AttachNewFile(Environ("windir") & "\system32\mscomct2.ocx")
End Sub
[/vba]
на других компьютерах при открытии файла
[vba]
Код
Sub ИзвлечьФайл()    ' извлекаем и регистрируем
    Dim FileManager As New AttachedFiles, res As Boolean
    On Error Resume Next ' на случай, если среди вложений нет файла mscomct2.ocx
    If Dir$(Environ("windir") & "\system32\mscomct2.ocx") = "" Then _
    res = FileManager.GetAttachment("mscomct2.ocx").SaveAs(Environ("windir") & "\system32\mscomct2.ocx")
    CreateObject("wscript.shell").Run ("regsvr32.exe """ & Environ("windir") & "\system32\mscomct2.ocx" & """ /s")
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 13.12.2016 в 16:36
krosav4ig Дата: Вторник, 13.12.2016, 12:10 | Сообщение № 982 | Тема: Красивые числа на сайте
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
там еще одна спрятана
Код
9+3+9+0+3+9+6+9=48
Код
4+8=12
Код
1+2=3

:)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениетам еще одна спрятана
Код
9+3+9+0+3+9+6+9=48
Код
4+8=12
Код
1+2=3

:)

Автор - krosav4ig
Дата добавления - 13.12.2016 в 12:10
krosav4ig Дата: Понедельник, 12.12.2016, 22:51 | Сообщение № 983 | Тема: Как заложить в формулу ссылку на ячейку из предыдущего листа
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ilya-yurasov, чтобы работала функция ПредыдущийЛист(), нужно код
[vba]
Код
Function ПредыдущийЛист() As Range
    With Parent.Caller.Parent
        Set ПредыдущийЛист = .Parent.Sheets(.Index - 1).UsedRange
    End With
End Function
[/vba]
вставить в стандартный модуль (он же просто модуль, про который писал Wasilich )
для этого
открываете свою книгу, где нужна эта функция
переводите раскладку клавиатуры на англицкий
зажимаете Alt и жмете по очереди F11 I M
вставляете вышеуказанный код, где заморгал текстовый курсор

из серии "Найди отличие"
Код
=ВПР(A3;cc;9;)

Код
=ВПР(A3;cc;9)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 12.12.2016, 22:52
 
Ответить
Сообщениеilya-yurasov, чтобы работала функция ПредыдущийЛист(), нужно код
[vba]
Код
Function ПредыдущийЛист() As Range
    With Parent.Caller.Parent
        Set ПредыдущийЛист = .Parent.Sheets(.Index - 1).UsedRange
    End With
End Function
[/vba]
вставить в стандартный модуль (он же просто модуль, про который писал Wasilich )
для этого
открываете свою книгу, где нужна эта функция
переводите раскладку клавиатуры на англицкий
зажимаете Alt и жмете по очереди F11 I M
вставляете вышеуказанный код, где заморгал текстовый курсор

из серии "Найди отличие"
Код
=ВПР(A3;cc;9;)

Код
=ВПР(A3;cc;9)

Автор - krosav4ig
Дата добавления - 12.12.2016 в 22:51
krosav4ig Дата: Понедельник, 12.12.2016, 03:12 | Сообщение № 984 | Тема: Как заложить в формулу ссылку на ячейку из предыдущего листа
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ilya-yurasov, если все-таки пользоваться макрофункциями, то лучше вторым вариантом из моего поста (с листом макросов), ибо могут возникнуть проблемы в расчетах при переключении на другие книги.
по поводу формулы - забыл указать последний аргумент. Должно быть так
Код
=ВПР(A3;cc;9;)

Добавил UDF
[vba]
Код
Function ПредыдущийЛист() As Range
    With Parent.Caller.Parent
        Set ПредыдущийЛист = .Parent.Sheets(.Index - 1).UsedRange
    End With
End Function
[/vba]
К сообщению приложен файл: 3854908.xlsm (25.3 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 12.12.2016, 03:14
 
Ответить
Сообщениеilya-yurasov, если все-таки пользоваться макрофункциями, то лучше вторым вариантом из моего поста (с листом макросов), ибо могут возникнуть проблемы в расчетах при переключении на другие книги.
по поводу формулы - забыл указать последний аргумент. Должно быть так
Код
=ВПР(A3;cc;9;)

Добавил UDF
[vba]
Код
Function ПредыдущийЛист() As Range
    With Parent.Caller.Parent
        Set ПредыдущийЛист = .Parent.Sheets(.Index - 1).UsedRange
    End With
End Function
[/vba]

Автор - krosav4ig
Дата добавления - 12.12.2016 в 03:12
krosav4ig Дата: Пятница, 09.12.2016, 17:37 | Сообщение № 985 | Тема: Сравнение двух списков
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ВПР
Код
=--ПРАВБ(ВПР(F3&" "&G3&"*";ТЕКСТ($B$3:$B$93;""""&$A$3:$A$93&""" ГГГГ-ММ-ДД"" 00:00:00.0000"&ПОВТОР(" ";60)&$C$3:$C$93&"""");1;);60)
К сообщению приложен файл: 3523069.xls (58.5 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 09.12.2016, 17:37
 
Ответить
Сообщение
ВПР
Код
=--ПРАВБ(ВПР(F3&" "&G3&"*";ТЕКСТ($B$3:$B$93;""""&$A$3:$A$93&""" ГГГГ-ММ-ДД"" 00:00:00.0000"&ПОВТОР(" ";60)&$C$3:$C$93&"""");1;);60)

Автор - krosav4ig
Дата добавления - 09.12.2016 в 17:37
krosav4ig Дата: Пятница, 09.12.2016, 16:49 | Сообщение № 986 | Тема: Скачать (Сохранить) файл с Яндекс-диска макросом Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Эт я просто забыл, каким методом логин/пароль задавать, вот и решил посмотреть (на всякий случай, вдруг в проксю упрется). В MSDN лезть лень, добавил референс, зачем-то %) обьявил переменную, полез в object explorer, поковырялся там, нашел SetCredentials, но не нашел никакой инфы про HTTPREQUEST_SETCREDENTIALS_FLAGS, все равно пришлось лезть в MSDN, референс отключил, а переменную затереть забыл :(


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЭт я просто забыл, каким методом логин/пароль задавать, вот и решил посмотреть (на всякий случай, вдруг в проксю упрется). В MSDN лезть лень, добавил референс, зачем-то %) обьявил переменную, полез в object explorer, поковырялся там, нашел SetCredentials, но не нашел никакой инфы про HTTPREQUEST_SETCREDENTIALS_FLAGS, все равно пришлось лезть в MSDN, референс отключил, а переменную затереть забыл :(

Автор - krosav4ig
Дата добавления - 09.12.2016 в 16:49
krosav4ig Дата: Пятница, 09.12.2016, 11:48 | Сообщение № 987 | Тема: Скачать (Сохранить) файл с Яндекс-диска макросом Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вроде, лишняя
Вроде, лишняя (?)

ага, как-то сама затесалась #этнияоносамо :)
Может, оформить Готовым решением?

может быть, но, чтобы решение было прям совсем готовое, нужно (имхо) его дополнить проверками на ошибки и хоть немного откомментировать, а на это у мну сейчас времени немного не хватает :(


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВроде, лишняя
Вроде, лишняя (?)

ага, как-то сама затесалась #этнияоносамо :)
Может, оформить Готовым решением?

может быть, но, чтобы решение было прям совсем готовое, нужно (имхо) его дополнить проверками на ошибки и хоть немного откомментировать, а на это у мну сейчас времени немного не хватает :(

Автор - krosav4ig
Дата добавления - 09.12.2016 в 11:48
krosav4ig Дата: Пятница, 09.12.2016, 09:55 | Сообщение № 988 | Тема: Скачать (Сохранить) файл с Яндекс-диска макросом Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Исправил свой код, так должно работать
[vba]
Код
Private Const Login$ = "Логин", Pwd$ = "Пароль"
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", urlencode(Host & RemoteFilePath$), True
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Authorization", "Basic " & Token
        .send
        .WaitForResponse
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, RemotePath$)
    Dim FileContents As Variant, FileName$
    FileName = StrReverse(Split(StrReverse(LocalFilePath), "\")(0))
    RemotePath = IIf(RemotePath <> "", RemotePath & "/", "")
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "PUT", urlencode(Host & RemotePath & FileName), False
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Etag", MD5(FileContents)
        .SetRequestHeader "Sha256", Sha256(FileContents)
        .SetRequestHeader "Expect", "100-continue"
        .SetRequestHeader "Content-Type", "application/binary"
        .SetRequestHeader "Authorization", "Basic " & Token
        .SetRequestHeader "Content-Length", UBound(FileContents) + 1
        .send FileContents
        .WaitForResponse
        Debug.Print "Файл "; IIf(.StatusText = "Created", "успешно загружен", "не загружен")
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login & ":" & Pwd): Token = .Text
    End With
End Function
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 09.12.2016, 14:00
 
Ответить
СообщениеИсправил свой код, так должно работать
[vba]
Код
Private Const Login$ = "Логин", Pwd$ = "Пароль"
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", urlencode(Host & RemoteFilePath$), True
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Authorization", "Basic " & Token
        .send
        .WaitForResponse
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, RemotePath$)
    Dim FileContents As Variant, FileName$
    FileName = StrReverse(Split(StrReverse(LocalFilePath), "\")(0))
    RemotePath = IIf(RemotePath <> "", RemotePath & "/", "")
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "PUT", urlencode(Host & RemotePath & FileName), False
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Etag", MD5(FileContents)
        .SetRequestHeader "Sha256", Sha256(FileContents)
        .SetRequestHeader "Expect", "100-continue"
        .SetRequestHeader "Content-Type", "application/binary"
        .SetRequestHeader "Authorization", "Basic " & Token
        .SetRequestHeader "Content-Length", UBound(FileContents) + 1
        .send FileContents
        .WaitForResponse
        Debug.Print "Файл "; IIf(.StatusText = "Created", "успешно загружен", "не загружен")
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login & ":" & Pwd): Token = .Text
    End With
End Function
[/vba]

Автор - krosav4ig
Дата добавления - 09.12.2016 в 09:55
krosav4ig Дата: Пятница, 09.12.2016, 09:52 | Сообщение № 989 | Тема: Сравнение двух ячеек с текстом и вывод значения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Исправил формулу в предыдущем посте


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеИсправил формулу в предыдущем посте

Автор - krosav4ig
Дата добавления - 09.12.2016 в 09:52
krosav4ig Дата: Пятница, 09.12.2016, 06:23 | Сообщение № 990 | Тема: Сравнение двух ячеек с текстом и вывод значения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
во второй формуле не учел пустые ячейки в ключах
вот так должно быть
Код
=МАКС((СУММПРОИЗВ(СЧЁТЕСЛИ(K3;"*"&ПСТР(Z3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*")+СЧЁТЕСЛИ(Z3;"*"&ПСТР(K3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*"))-МАКС(ДЛСТР(K3);ДЛСТР(Z3)))/МАКС(ДЛСТР(K3);ДЛСТР(Z3));--(Z3<=""))


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 09.12.2016, 11:00
 
Ответить
Сообщениево второй формуле не учел пустые ячейки в ключах
вот так должно быть
Код
=МАКС((СУММПРОИЗВ(СЧЁТЕСЛИ(K3;"*"&ПСТР(Z3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*")+СЧЁТЕСЛИ(Z3;"*"&ПСТР(K3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*"))-МАКС(ДЛСТР(K3);ДЛСТР(Z3)))/МАКС(ДЛСТР(K3);ДЛСТР(Z3));--(Z3<=""))

Автор - krosav4ig
Дата добавления - 09.12.2016 в 06:23
krosav4ig Дата: Четверг, 08.12.2016, 23:39 | Сообщение № 991 | Тема: Как заложить в формулу ссылку на ячейку из предыдущего листа
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
До кучи,
решение через макрофункции в диспетчере имен (первый файл)
Код
aa    =ЯЧЕЙКА("имяфайла";ТЕКСТССЫЛ("RC"))
Код
bb    =ПОЛУЧИТЬ.РАБОЧУЮ.КНИГУ(1)
Код
cc    =ТЕКСТССЫЛ(ФОРМУЛА.ПРЕОБРАЗОВАТЬ("'"&ИНДЕКС(bb;ПОИСКПОЗ(ЗАМЕНИТЬ(aa;1;ПОИСК("[";aa)-1;);bb)-1)&"'!A2:I999";1;0;1))

формула в ячейке
Код
=ВПР(A2;cc;9)

И через скрытый лист макросов (второй файл)
в листе макросов
[vba]
Код
=АРГУМЕНТ("cell";8)
=ЯЧЕЙКА("имяФайла";cell)
=ПОИСК("[";A2)
=ПСТР(A2;A3+1;МУМНОЖ(ПОИСК({"]";"["};A2);{1:-1})-1)
=УСТАНОВИТЬ.ИМЯ("листы";ПОЛУЧИТЬ.РАБОЧУЮ.КНИГУ(1;A4))
="'"&ИНДЕКС(листы;ПОИСКПОЗ(ЗАМЕНИТЬ(A2;1;A3-1;);листы)-1)&"'!A2:I999"
=ВОЗВРАТ(ВПР(cell;ТЕКСТССЫЛ(ФОРМУЛА.ПРЕОБРАЗОВАТЬ(A6;1;0;1));9;))
[/vba]
в ячейке
Код
=НачалоСмены(A2)
К сообщению приложен файл: 9894033-1.xlsm (14.4 Kb) · 9894033-2.xlsm (15.7 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 08.12.2016, 23:49
 
Ответить
СообщениеДо кучи,
решение через макрофункции в диспетчере имен (первый файл)
Код
aa    =ЯЧЕЙКА("имяфайла";ТЕКСТССЫЛ("RC"))
Код
bb    =ПОЛУЧИТЬ.РАБОЧУЮ.КНИГУ(1)
Код
cc    =ТЕКСТССЫЛ(ФОРМУЛА.ПРЕОБРАЗОВАТЬ("'"&ИНДЕКС(bb;ПОИСКПОЗ(ЗАМЕНИТЬ(aa;1;ПОИСК("[";aa)-1;);bb)-1)&"'!A2:I999";1;0;1))

формула в ячейке
Код
=ВПР(A2;cc;9)

И через скрытый лист макросов (второй файл)
в листе макросов
[vba]
Код
=АРГУМЕНТ("cell";8)
=ЯЧЕЙКА("имяФайла";cell)
=ПОИСК("[";A2)
=ПСТР(A2;A3+1;МУМНОЖ(ПОИСК({"]";"["};A2);{1:-1})-1)
=УСТАНОВИТЬ.ИМЯ("листы";ПОЛУЧИТЬ.РАБОЧУЮ.КНИГУ(1;A4))
="'"&ИНДЕКС(листы;ПОИСКПОЗ(ЗАМЕНИТЬ(A2;1;A3-1;);листы)-1)&"'!A2:I999"
=ВОЗВРАТ(ВПР(cell;ТЕКСТССЫЛ(ФОРМУЛА.ПРЕОБРАЗОВАТЬ(A6;1;0;1));9;))
[/vba]
в ячейке
Код
=НачалоСмены(A2)

Автор - krosav4ig
Дата добавления - 08.12.2016 в 23:39
krosav4ig Дата: Четверг, 08.12.2016, 22:26 | Сообщение № 992 | Тема: Excel.ActiveWorkbook.Save в режиме редактирования/записи
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
первой строкой пишем[vba]
Код
If GetAttr(ThisWorkbook.FullName) And 1 Then Exit Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 08.12.2016, 22:27
 
Ответить
Сообщениепервой строкой пишем[vba]
Код
If GetAttr(ThisWorkbook.FullName) And 1 Then Exit Sub
[/vba]

Автор - krosav4ig
Дата добавления - 08.12.2016 в 22:26
krosav4ig Дата: Четверг, 08.12.2016, 19:47 | Сообщение № 993 | Тема: Сравнение двух ячеек с текстом и вывод значения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте так нужно?
Код
=ТЕКСТ(СУММПРОИЗВ(СЧЁТЕСЛИ(K3;"*"&ПСТР(Z3;СТРОКА(A$1:ИНДЕКС(A:A;ДЛСТР(Z3)));1)&"*")+СЧЁТЕСЛИ(Z3;"*"&ПСТР(K3;СТРОКА(A$1:ИНДЕКС(A:A;ДЛСТР(K3)));1)&"*"))/2;"[=0]0;[="&ДЛСТР(K3)&"]1;""0,5""")+ЕПУСТО(Z3)

или может быть даже так (второй файл)
Код
=МАКС((СУММПРОИЗВ(СЧЁТЕСЛИ(K3;"*"&ПСТР(Z3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*")+СЧЁТЕСЛИ(Z3;"*"&ПСТР(K3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*"))-МАКС(ДЛСТР(K3);ДЛСТР(Z3)))/МАКС(ДЛСТР(K3);ДЛСТР(Z3));)
К сообщению приложен файл: 3752978.zip (68.1 Kb) · 2240013.zip (68.2 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 08.12.2016, 20:04
 
Ответить
СообщениеЗдравствуйте так нужно?
Код
=ТЕКСТ(СУММПРОИЗВ(СЧЁТЕСЛИ(K3;"*"&ПСТР(Z3;СТРОКА(A$1:ИНДЕКС(A:A;ДЛСТР(Z3)));1)&"*")+СЧЁТЕСЛИ(Z3;"*"&ПСТР(K3;СТРОКА(A$1:ИНДЕКС(A:A;ДЛСТР(K3)));1)&"*"))/2;"[=0]0;[="&ДЛСТР(K3)&"]1;""0,5""")+ЕПУСТО(Z3)

или может быть даже так (второй файл)
Код
=МАКС((СУММПРОИЗВ(СЧЁТЕСЛИ(K3;"*"&ПСТР(Z3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*")+СЧЁТЕСЛИ(Z3;"*"&ПСТР(K3;СТРОКА(A$1:ИНДЕКС(A:A;МАКС(ДЛСТР(K3);ДЛСТР(Z3))));1)&"*"))-МАКС(ДЛСТР(K3);ДЛСТР(Z3)))/МАКС(ДЛСТР(K3);ДЛСТР(Z3));)

Автор - krosav4ig
Дата добавления - 08.12.2016 в 19:47
krosav4ig Дата: Четверг, 08.12.2016, 18:58 | Сообщение № 994 | Тема: Импорт XML > Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
К сообщению приложен файл: Import.xlsx (13.7 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеимпорт по карте xml не подходит?
создание карты
Сопоставление XML-элементов ячейкам листа
Импорт данных по существующей карте xml

Автор - krosav4ig
Дата добавления - 08.12.2016 в 18:58
krosav4ig Дата: Четверг, 08.12.2016, 18:07 | Сообщение № 995 | Тема: Выбор части текста и отразить в разных ячейках
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
как-то так
Код
=СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ($A2;СИМВОЛ(10);ПОВТОР(" ";999));СТОЛБЕЦ(A2)*999+1;999))
К сообщению приложен файл: _1-2-.xlsx (10.1 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
как-то так
Код
=СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ($A2;СИМВОЛ(10);ПОВТОР(" ";999));СТОЛБЕЦ(A2)*999+1;999))

Автор - krosav4ig
Дата добавления - 08.12.2016 в 18:07
krosav4ig Дата: Четверг, 08.12.2016, 17:31 | Сообщение № 996 | Тема: runtime error 1004 Новая
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
наверно не успевает файл сохраниться, пробуйте так
[vba]
Код
Private Declare Function CreateFile _
    Lib "kernel32" _
    Alias "CreateFileA" ( _
        ByVal lpFileName As String, _
        ByVal dwDesiredAccess As Long, _
        ByVal dwShareMode As Long, _
        ByRef lpSecurityAttributes As Any, _
        ByVal dwCreationDistribution As Long, _
        ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As Long _
    ) As Long
Private Declare Function CloseHandle _
    Lib "kernel32" ( _
        ByVal hObject As Long _
    ) As Long
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Sheets("Лист2").Select
    ActiveWorkbook.RefreshAll
    Sheets("Лист3").Select
    Range("A1").Select
    ActiveSheet.PivotTables("СводнаяТаблица3").PivotFields("Shipping Order"). _
    ClearAllFilters
    With ActiveSheet.PivotTables("СводнаяТаблица3").PivotFields("Shipping Order")
    .PivotItems("").Visible = False
    .PivotItems("(пусто)").Visible = False
    End With
    Sheets("Лист1").Select
    ActiveWorkbook.RefreshAll
    Dim Wb As Workbook
    Dim WbName As String
    Dim iPath As String
    Dim iFilePath As String
    Set Wb = ActiveWorkbook
    WbName = Wb.FullName
    iPath = ThisWorkbook.Path & "\"
    iFilePath = Left(WbName, InStrRev(WbName, ".") - 1) + " " + Format(Date, "dd/mm/yyyy") + ".xls"
    If Dir(iFilePath) <> "" Then
    MsgBox "Копия файла c датой " & Format(Date, "yyyy/mm/dd") & " в директории " & Chr(13) & iPath$ & " уже существует!", vbExclamation
    Exit Sub
    End If
    Wb.SaveCopyAs iFilePath
    Dim IsSaved As Boolean
    Do Until IsSaved
        hfile = CreateFile(FilePath, &H80000000, &H1, 0, 3, 0, 0)
        IsSaved = hfile <> -1
        CloseHandle hfile
        DoEvents
    Loop
    Workbooks.Open iFilePath
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Лист2").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Лист3").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Лист4").Select
    ActiveWindow.SelectedSheets.Delete
End Sub
[/vba]
и вот тут почитайте


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениенаверно не успевает файл сохраниться, пробуйте так
[vba]
Код
Private Declare Function CreateFile _
    Lib "kernel32" _
    Alias "CreateFileA" ( _
        ByVal lpFileName As String, _
        ByVal dwDesiredAccess As Long, _
        ByVal dwShareMode As Long, _
        ByRef lpSecurityAttributes As Any, _
        ByVal dwCreationDistribution As Long, _
        ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As Long _
    ) As Long
Private Declare Function CloseHandle _
    Lib "kernel32" ( _
        ByVal hObject As Long _
    ) As Long
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Sheets("Лист2").Select
    ActiveWorkbook.RefreshAll
    Sheets("Лист3").Select
    Range("A1").Select
    ActiveSheet.PivotTables("СводнаяТаблица3").PivotFields("Shipping Order"). _
    ClearAllFilters
    With ActiveSheet.PivotTables("СводнаяТаблица3").PivotFields("Shipping Order")
    .PivotItems("").Visible = False
    .PivotItems("(пусто)").Visible = False
    End With
    Sheets("Лист1").Select
    ActiveWorkbook.RefreshAll
    Dim Wb As Workbook
    Dim WbName As String
    Dim iPath As String
    Dim iFilePath As String
    Set Wb = ActiveWorkbook
    WbName = Wb.FullName
    iPath = ThisWorkbook.Path & "\"
    iFilePath = Left(WbName, InStrRev(WbName, ".") - 1) + " " + Format(Date, "dd/mm/yyyy") + ".xls"
    If Dir(iFilePath) <> "" Then
    MsgBox "Копия файла c датой " & Format(Date, "yyyy/mm/dd") & " в директории " & Chr(13) & iPath$ & " уже существует!", vbExclamation
    Exit Sub
    End If
    Wb.SaveCopyAs iFilePath
    Dim IsSaved As Boolean
    Do Until IsSaved
        hfile = CreateFile(FilePath, &H80000000, &H1, 0, 3, 0, 0)
        IsSaved = hfile <> -1
        CloseHandle hfile
        DoEvents
    Loop
    Workbooks.Open iFilePath
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Лист2").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Лист3").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Лист4").Select
    ActiveWindow.SelectedSheets.Delete
End Sub
[/vba]
и вот тут почитайте

Автор - krosav4ig
Дата добавления - 08.12.2016 в 17:31
krosav4ig Дата: Четверг, 08.12.2016, 14:38 | Сообщение № 997 | Тема: Сумма прописью в Word - Как допилить?
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
iam_alex, [vba]
Код
UCase(Left(m, 1)) & Mid(m, 2)
[/vba] замените на [vba]
Код
RTrim(UCase(Left(m, 1)) & Mid(m, 2))
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеiam_alex, [vba]
Код
UCase(Left(m, 1)) & Mid(m, 2)
[/vba] замените на [vba]
Код
RTrim(UCase(Left(m, 1)) & Mid(m, 2))
[/vba]

Автор - krosav4ig
Дата добавления - 08.12.2016 в 14:38
krosav4ig Дата: Четверг, 08.12.2016, 01:25 | Сообщение № 998 | Тема: Поиск всех вариантов при совпадении одной строки
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
так нужно?
Код
=НАИМЕНЬШИЙ(ЕСЛИ(D$6:D$239=$F$5;B$6:B$239+C$6:C$239);СТРОКА(F1))
К сообщению приложен файл: 11111.xlsx (20.7 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 08.12.2016, 01:25
 
Ответить
СообщениеЗдравствуйте
так нужно?
Код
=НАИМЕНЬШИЙ(ЕСЛИ(D$6:D$239=$F$5;B$6:B$239+C$6:C$239);СТРОКА(F1))

Автор - krosav4ig
Дата добавления - 08.12.2016 в 01:25
krosav4ig Дата: Четверг, 08.12.2016, 01:10 | Сообщение № 999 | Тема: Скачать (Сохранить) файл с Яндекс-диска макросом Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ошибка загрузки указанного контента

печалько :(
кстати, можно прямо в VBA подключать нужную папку ЯДиска
[vba]
Код
CreateObject("WScript.Network").MapNetworkDrive "W:", "https://webdav.yandex.ru:443/Документы/Клиент/Templates", False, "Login", "Password"
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
ошибка загрузки указанного контента

печалько :(
кстати, можно прямо в VBA подключать нужную папку ЯДиска
[vba]
Код
CreateObject("WScript.Network").MapNetworkDrive "W:", "https://webdav.yandex.ru:443/Документы/Клиент/Templates", False, "Login", "Password"
[/vba]

Автор - krosav4ig
Дата добавления - 08.12.2016 в 01:10
krosav4ig Дата: Среда, 07.12.2016, 13:46 | Сообщение № 1000 | Тема: Скачать (Сохранить) файл с Яндекс-диска макросом Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Нарисовал функции для скачивания/выгрузки на ЯДиск
скачивание проходит нормально, а вот с выгрузкой чего-то не так. В корень вообще не загружает, в папки грузит мягко говоря, через раз, может чего лишнего понаписал или не те объекты использовал
[vba]
Код
Private Const Login$ = "Логин", Pwd$ = "Пароль"
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo$)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "get", urlencode(Host & RemoteFilePath), False, Login, Pwd
        .setrequestheader "Host", "webdav.yandex.ru"
        .setrequestheader "Accept", "*/*"
        .setrequestheader "Authorization", "Basic " & Token
        .send
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, RemotePath$)
    Dim FileContents As Variant, FileName$
    FileName = StrReverse(Split(StrReverse(LocalFilePath), "\")(0))
    RemotePath = IIf(RemotePath <> "", RemotePath & "/", "")
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("MSXML2.XMLHTTP")
        .Open "put", urlencode(Host & RemotePath & FileName), False, Login, Pwd
        .setrequestheader "Host", "webdav.yandex.ru"
        .setrequestheader "Accept", "*/*"
        .setrequestheader "Transfer-Encoding", "chunked"
        .setrequestheader "Etag", MD5(FileContents)
        .setrequestheader "Sha256", Sha256(FileContents)
        .setrequestheader "Expect", "100-continue"
        .setrequestheader "Content-Type", "application/binary"
        .setrequestheader "Authorization", "Basic " & Token
        .setrequestheader "Content-Length", UBound(FileContents) + 1
        .send FileContents
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login): Token = .Text & ":"
        .nodeTypedValue = Str2Byte(Pwd): Token = Token & .Text
    End With
End Function

Sub test()
    'открываем файл из папки 111 в ЯДиске
    Workbooks.Open DownloadFile("123/1.xlsm", "D:\")
    'открываем файл из корня ЯДиска
    Workbooks.Open DownloadFile("123.xlsx", Environ("tmp"))
    'выгружаем файл в папку 123 в ЯДиске
    UploadFile "D:\0.xlsm", "123"
    'выгружаем файл в корень в ЯДиска    не грузит
    UploadFile "D:\0.xlsm", ""
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Среда, 07.12.2016, 13:47
 
Ответить
СообщениеНарисовал функции для скачивания/выгрузки на ЯДиск
скачивание проходит нормально, а вот с выгрузкой чего-то не так. В корень вообще не загружает, в папки грузит мягко говоря, через раз, может чего лишнего понаписал или не те объекты использовал
[vba]
Код
Private Const Login$ = "Логин", Pwd$ = "Пароль"
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo$)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "get", urlencode(Host & RemoteFilePath), False, Login, Pwd
        .setrequestheader "Host", "webdav.yandex.ru"
        .setrequestheader "Accept", "*/*"
        .setrequestheader "Authorization", "Basic " & Token
        .send
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, RemotePath$)
    Dim FileContents As Variant, FileName$
    FileName = StrReverse(Split(StrReverse(LocalFilePath), "\")(0))
    RemotePath = IIf(RemotePath <> "", RemotePath & "/", "")
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("MSXML2.XMLHTTP")
        .Open "put", urlencode(Host & RemotePath & FileName), False, Login, Pwd
        .setrequestheader "Host", "webdav.yandex.ru"
        .setrequestheader "Accept", "*/*"
        .setrequestheader "Transfer-Encoding", "chunked"
        .setrequestheader "Etag", MD5(FileContents)
        .setrequestheader "Sha256", Sha256(FileContents)
        .setrequestheader "Expect", "100-continue"
        .setrequestheader "Content-Type", "application/binary"
        .setrequestheader "Authorization", "Basic " & Token
        .setrequestheader "Content-Length", UBound(FileContents) + 1
        .send FileContents
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login): Token = .Text & ":"
        .nodeTypedValue = Str2Byte(Pwd): Token = Token & .Text
    End With
End Function

Sub test()
    'открываем файл из папки 111 в ЯДиске
    Workbooks.Open DownloadFile("123/1.xlsm", "D:\")
    'открываем файл из корня ЯДиска
    Workbooks.Open DownloadFile("123.xlsx", Environ("tmp"))
    'выгружаем файл в папку 123 в ЯДиске
    UploadFile "D:\0.xlsm", "123"
    'выгружаем файл в корень в ЯДиска    не грузит
    UploadFile "D:\0.xlsm", ""
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 07.12.2016 в 13:46
Поиск:

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