Может проще что-то в системе документооборота поправить? а то она может обращаться к Formula, а достаточно получить Value
Бесполезно. Разработчик официально подтвердил, что он ничего сделать не может. Потому и возникла эта тема.
Разработчики тоже мне делают заявления типа "...получается динамический состав колонок в наборе данных. Excel с такими вещами не работает" тогда как вопрос решался элементарным парсингом строки.
Система уже куплена. Делать нечего - приходится извращаться. Фича может быть и будет в этой проге, но не сейчас точно. А дневники должны в школе уже публиковаться. Так что надо то, что в теме и запросил. Более того данный способ сэкономит деньги школе. Так как на одну страничку будет один логин, а не 20-30(по количеству детей в классе). Разрабы сами виноваты, не будет у них дозакупки лицензий до всего количества учеников
.Спасибо. Жду.
Function GetPassword(ByVal Name As String) As String
a = 0
For i = 1 To Len(Name)
a = a + Asc(Mid(Name, i, 1))
Next i
GetPassword = a
End Function
Sub Ìàêðîñ1()
SrcPath = Application.ActiveWorkbook.Path
If SrcPath = "" Then Exit Sub
If Right(SrcPath, 1) <> "\" Then SrcPath = SrcPath & "\"
DstPath = SrcPath & "Без формул\"
On Error GoTo MkDirErr
MkDir ("Без формул")
MkDirErr:
Passwords$ = SrcPath & "passwords.txt"
Open Passwords$ For Output As #1
Close #1
sFile = FileSystem.Dir(SrcPath & "*.XLS")
Do While sFile <> ""
Workbooks.Open Filename:=SrcPath & sFile
pass$ = GetPassword(sFile)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=DstPath & sFile, _
FileFormat:=xlNormal, Password:=pass$, _
ReadOnlyRecommended:=True, CreateBackup:=False
Application.DisplayAlerts = True
Open Passwords$ For Append As #1
Write #1, sFile & " " & pass$ & Chr(13) & Chr(10)
Close #1
sFile = FileSystem.Dir()
Loop
End Sub Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=FalseНу я ж самый простой хэш для начала сотворил. Да и кто там из школьников символы суммировать будет что ли?
То есть в коде _MBK_ этого нет? Если нет то в какое место кода добавить Ваши строчки?
Создать документ, Alt+F11, Insert-Module, скопировать весь код и поправить русское название в названии функции. Запускать по Alt+F8.
Ни одного макроса не видно...
Не помогает. Module же это не макрос, я так понимаю.
А код в Module1 скопировал?
Да вот думаю, может просто в папке с файлами исходника пусть будет ярлык на запуск макроса?
Function GetPassword(ByVal Name As String) As String
a = 0
For i = 1 To Len(Name)
a = a + Asc(Mid(Name, i, 1))
Next i
GetPassword = a
End Function
Sub in1()
SrcPath = Application.ActiveWorkbook.Path
If SrcPath = "" Then Exit Sub
If Right(SrcPath, 1) <> "\" Then SrcPath = SrcPath & "\"
DstPath = SrcPath & "Без формул\"
On Error GoTo MkDirErr
MkDir ("Без формул")
MkDirErr:
Passwords$ = SrcPath & "passwords.txt"
Open Passwords$ For Output As #1
Close #1
sFile = FileSystem.Dir(SrcPath & "*.XLS")
Do While sFile <> ""
Workbooks.Open Filename:=SrcPath & sFile
pass$ = GetPassword(sFile)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=DstPath & sFile, _
FileFormat:=xlNormal, Password:=pass$, _
ReadOnlyRecommended:=True, CreateBackup:=False
Application.DisplayAlerts = True
Open Passwords$ For Append As #1
Write #1, sFile & " " & pass$ & Chr(13) & Chr(10)
Close #1
ActiveWorkbook.Close
sFile = FileSystem.Dir()
Loop
End SubТогда конечно, сделать файл в котором только запуск макроса и самозакрытие.
Первую строчку пропустил, уже исправился... добавил только закрытие сохраненного документа, а то не все любят щелкать на меню файл с зажатым шифтом.
