Я создал пользовательскую ленту. И тут вдруг захотелось добавить на неё красивый логотип. Но при поиске нагуглилось что картинки можно добавлять только к кнопкам (button) Т.е. нет способа добавить в ленту картинку напр, 100х64 пикселей??
и всй было хорошо, пока не оказалось, что для америки надо WEEKDAY(B13,3)+6 заменить на WEEKDAY(B13,3)+5, а для Израиля WEEKDAY(B13,3)+4 что то у меня уже перегрев процессора, прошу помощи зала, можт формулу как то можно переписать, или подскажите как такой коэфициэнт макросом подобрать примерчик прилагаю, формула в столбце L
Ситуация такая: есть макрос на юзерформ, сохраняющий книгу и закрывающий Ексель.
Код
Public Sub bookBfCose()
If Worksheets.Count > 3 And Left(ThisWorkbook.Name, 5) <> "Last_" Then
Call MakeBkFolder
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & _
"\backup\Last_Reports_Session_From_" & Format(Now(), "dd-mm-yyyy-hh-nn-ss") & ".xls"
End If
ActiveWorkbook.Save
ActiveWorkbook.Close savechanges:=False
ChangeInterface True
Application.Quit
End Sub
проект VBA запаролен. И вот, при нажатии этой книпочки, которая всё закрывает, всё закрывавется, но с сообщением об ошибке, и что самое странное - с запросом пароля для VBA-кода. Причем ошибка воспроизводится далеко не во всех Excel - так у меня на рабочем точно ее нет, и у клиента после обновлений микрософтовских перестала появлятся. Но все же хотелось уточнить этот момент у коллективного разума: Действительно ли были версии Excel 2013 где макросы работали с ошибками? Можно что-то исправить в коде, или как то еще более хитро закрывать книгу?
Недавно возникла задача - закрыть код VBA. Сразу оговорюсь: парольная защита - ненадежна. Запароленый код открывается в OpenOffice Calc безо всяких проблем и паролей. Стал искать, все прелагают платные решения, которые либо не работают под 2010 и выше,либо за деньги - но всё равно не идеально. У меня получились неплохие результаты с DoneEx XCell Compiler - платный. Плюс - точно работает, код искажает в нечитаемый, большинство кода выносит в dll Недостаток - создается два файла - ексель и dll.
Неплохой (а главное - бесплатный) способ скрыть код найден у наших англоговорящих коллег ТУТ
Но от OpenOffice Calc он не спасает... Кто то может подсказать решение?
Есть готовый набор макросов и форм, собраных в лист, с которым работают конечные пользователи. Необходимо обеспечить их работоспособность в Excel для mac. Небольшое видео как оно работает:
Есть список дат. В некоторые даты происходит одно событие, в некоторые три, в некоторые - вообще не происходит. Каой формулой посчитать итог по событиям повторяющихся дат? пробовал и СЧЕТЕСЛИ и по форуму лазил вдолть-поперек, что то не могу сообразить как его сделать. Пример желаемого результата - в столбце С
Есть данные на листах 1-5. Можно ли создать некий "лист 6", на котором допустим, вывести строки листов 1-5 где нет данных в столбце B. И затем, если мы вводим недостающие данные в лист 6, они добавляются на соответвующий лист, где их не хватало.
Для примера: на некоторых листах есть данные за 1 мая, на некоторых - нет. Вот на которых нет - вывести на "лист для изменений"
Пытаюсь сделать выборку данных из файлика. Сначала загоняю значения в ексель
Код
Do Until EOF(1)
Line Input #1, textline
text = Split(textline, DELIMITER)
With Sheets(1)
.Cells(i, 1).Value = Int(text(0))
.Range("A" & i & "").NumberFormat = "0"
End With
i = i + 1
Loop
потом пытаюсь сделать выборку
Код
Select Case CLng(Split(Application.Version, ".")(0))
Case Is < 12
strSQL = "Select F1 from [" & Sheets(2).Name & "$] where F1=""" & rstTXT(0).Value & """;"
Case Is >= 12
strSQL = "Select F1 from [" & Sheets(2).Name & "$] where F1=" & rstTXT(0).Value & ";"
End Select
Else
GoTo 111
End If
'rst01.CursorLocation = 3
rst01.Open strSQL, cn, adOpenKeyset, adLockPessimistic
If rst01.RecordCount = 0 Then
r = 3
Rows(r).Insert Shift:=xlDown
Cells(r, 1).Value = rstTXT(0).Value
End If
rst01.Close
в rstTXT(0).Value - значение 301194460
ошибка "Data type mismatch in criteria expression" не понятно, почему не работает... причем если брать в кавычки - иногда работает, иногда нет
Уже пробовал такую тему тут поднять, мне ответили что все просто и понятно, но у меня не выходит надо открыть текстовый файл и выполнить к нему ряд запросов
Код
Dim rstTXT As Object
Dim strSQL01 As String, GetmyFile As String
Dim sCon
Dim cn As Object ' As ADODB.Connection
Set cn = CreateObject("ADODB.Connection") ' as New ADODB.Connection
'Dim cn As New ADODB.Connection
Set rstTXT = CreateObject("ADODB.Recordset") ' as New ADODB.Recordset
Dim myFile As String, text As Variant, textline As String, SetingF As String
Const DELIMITER As String = vbTab
i = 1
myFile = ""
ChDir ThisWorkbook.Path
myFile = Application.GetOpenFilename("Data Files (*.dat), *.dat")
'If FileExists(myFile) = True Then Open myFile For Input As #1
#If Win64 Then
#If VBA7 Then
sCon = "Driver=Microsoft Access Text Driver (*.txt, *.csv);Dbq=" & Left$(myFile, InStrRev(myFile, "\")) _
& ";Extensions=asc,csv,tab,txt;"
#Else
sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""" & Left$(myFile, InStrRev(myFile, "\")) & """" _
& ";Extended Properties=""text;HDR=No;FMT=Delimited"";"
#End If
#Else
sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""" & Left$(myFile, InStrRev(myFile, "\")) & """" _
& ";Extended Properties=""text;HDR=No;FMT=Delimited"";"
#End If
cn.Open sCon
If Not cn.State = 1 Then Exit Sub
'select only Empl ID
GetmyFile = Mid(myFile, InStrRev(myFile, "\") + 1)
strSQL01 = "Select Distinct F1 from [" & GetmyFile & "] group by F1;"
rstTXT.CursorLocation = 3
rstTXT.Open strSQL01, cn, adOpenKeyset, adLockPessimistic
For i = 1 To rstTXT.RecordCount
MsgBox "ok", vbOKOnly
Next i
End Sub
Есть данные, даты в которые человек отработал. Теперь необходимо добавить строки с датами, когда его в течении месяца на работе не было. Я написал код но в конце он как то неправильно работает. я так понимаю надо сдвигать границу диапазона, непойму как
Недавно клиент очень попросил переписать и перетестировать макрос на МАС. Задача дополнительно осложняется тем, что клиент потом шлет этот файлик своим партнерам Итак вопросы такие 1) Где почитать отличия в работе VBA for MacOffice 2) Сильны ли различия разных версий MacOffice? Где прочиать по совместимости?
И главный вопрос жизни, вселенной и всего прочего 3) Возможно ли совместить работающий на вин и мак код в одном ексель-листе?
Понимаю, что вопросы слегка пространные, но пока не могу даже мысли в кучу собрать
Sub ForTable(end_rng)
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$" & end_rng & "")).Name = "Table1"
'No go in 2003
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight20"
End Sub
Собственно, все работает, табличка становится красивенькой, но проблема в другом - по умолчанию мне надо скрывать все стандартные ексельные вкладки с риббона. А этот макрос открывает вкладку Table Tools, и что еще хуже -она остается активной, вместо моей самописной риббоновской. Как это пофиксить?
Dim rstDAO As Object
Dim strSQL01 As String, strSQL As String
Dim sCon$
Dim cn As Object ' As ADODB.Connection
Dim rs1 As Object ' As ADODB.Recordset
Dim rs31 As Object ' As ADODB.Recordset
Set cn = CreateObject("ADODB.Connection") ' as New ADODB.Connection
'Dim cn As New ADODB.Connection
Set rstDAO = CreateObject("ADODB.Recordset") ' as New ADODB.Recordset
Set rs1 = CreateObject("ADODB.Recordset")
Set rs31 = CreateObject("ADODB.Recordset")
With Application
.ScreenUpdating = False
End With
sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName _
& ";Extended Properties=""Excel 8.0;IMEX=1;HDR=No"";"
cn.Open sCon
If Not cn.State = 1 Then Exit Function
'save current sheet name
strSQL = "[" & ActiveSheet.Name & "$]"
strSQL01 = "Select DISTINCT F1 from " & strSQL & ""
rstDAO.Open strSQL01, cn
Как оказалось, это все хорошо и работает, но только если у вас не 64-битный офис В 64 битном офисе же провайдер Jet.OLEDB следует заменить на ACE.OLEDB.12.0, и казалось бы все, многим этого достаточно. Мне как всегда повезло быть срежи немногих.
В таком раскладе перестает работать strSQL01 = "Select DISTINCT F1 from " & strSQL & "". Если добавлять скобки или извращаться - пишет "слишком много параметров, ожидаю лишь 1"
Задача стоит так: есть объем данных, которые я читаю из текстового файла. В данных три поля - ИД, время и третье, логическое - 0/1 Надо сгрупировать поля с одинаковыми ИД и разнести их по разным листам
Т. к. я чуть больше привык к БД и Аксу, мне проще сделать "Select * from *" и я начал так решать: 1. читаю файл и заполняю прочитаным соответвующие поля в ADODB.Recordset (rstADO в примере) 2. Хотел сделать из него "Select * from *". Но что-то не идет, найденый пример придуман для Акцесс, и под рекордсет, существующий только временно в памяти переписать не вышло с первого захода.
Неработающий кусок с селектом
Код
Dim cn As Object ' As ADODB.Connection
Dim rs1 As Object ' As ADODB.Recordset
Set cn = CreateObject("ADODB.Connection") ' as New ADODB.Connection
Set rstDAO = CreateObject("ADODB.Recordset") ' as New ADODB.Recordset
strSQL = "CREATE VIEW MyTableView AS SELECT DISTINCT pid FROM rstADO;"
With cn
.Open
.Execute strSQL
End With
Тема, поражающая своей новизной: Как Excel сохранить как JSON? да, я нагуглил на этом форуме тему Раз и Два, но везде обсуждается как откуда-то получить Ясон и загнать его в Ексельку По своему же вопрсу я тоже нагуглил интересный код:
Скрытый текст
Код
Option Explicit
Sub export_in_json_format()
Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String
' change range here
Set rangetoexport = Sheet1.Range("a1:d8")
Set fs = CreateObject("Scripting.FileSystemObject")
' change dir here
Set jsonfile = fs.CreateTextFile("C:\Users\xx\Desktop\" & "jsondata.json", True)
linedata = "{""Output"": ["
jsonfile.WriteLine linedata
For rowcounter = 2 To rangetoexport.Rows.Count
linedata = ""
For columncounter = 1 To rangetoexport.Columns.Count
linedata = linedata & """" & rangetoexport.Cells(1,
columncounter) & """" & ":" & """" &
rangetoexport.Cells(rowcounter, columncounter) & """" & ","
Next
linedata = Left(linedata, Len(linedata) - 1)
If rowcounter = rangetoexport.Rows.Count Then
linedata = "{" & linedata & "}"
Else
linedata = "{" & linedata & "},"
End If
jsonfile.WriteLine linedata
Next
linedata = "]}"
jsonfile.WriteLine linedata
jsonfile.Close
Set fs = Nothing
End Sub
Для пущего удобства я изменил код под себя:
Код
' change range here
Set rangetoexport = Worksheets("Blad1").Range("$A:$J")
Set fs = CreateObject("Scripting.FileSystemObject")
' change dir here
datef = Format(Date, "dd-mm-yy")
timef = Format(Time(), "-hh-mm-ss")
Set jsonfile = fs.CreateTextFile(ActiveWorkbook.Path & "\" & datef & timef & ".json", True)
Собственно вопрос: Существует ли лучшее решение для сохранения в Ясон?