Модераторы: mihanik

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Ms Access + MS Excel, Работа из excel в access 
:(
    Опции темы
Akina
Дата 22.10.2007, 14:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454
Цитата(kall1sto @  22.10.2007,  12:41 Найти цитируемый пост)
поставил бы тебе + к репутации, но не могу ... 

Сделано.


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.
PM MAIL WWW ICQ Jabber   Вверх
kall1sto
Дата 23.10.2007, 10:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
Цитата

Надо найти заданный номер на Excel'овском листе или в Access'овской таблице?

Вообще надо было найти в access.... но уже разобрался 
просто не понимал вот этой строки:  RST.MoveNext, но разобрался
Вообщем теперь скрипт работает... НО только на моей машинке... вроде на другой машинке подключил все библиотеки... заново установил параметры безапасности, кричит на код Activeproject, хотя библиотеку проджекта точно подключил... Я туплю? или кто нить знает решение? )
PM MAIL   Вверх
kapbepucm
Дата 24.10.2007, 09:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 3
Всего: 12
Раскажи, где именно кричит. (на какую строку и что кричит)


--------------------
(С) kapbepucm
PM MAIL Skype   Вверх
kall1sto
Дата 24.10.2007, 10:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
просто туплю... (, просто мой скрипт сча выложу... знающие поймут, не знающему это не поможет:
Код

Private Sub CommandButton1_Click()
Const MDBFileName As String = ""
Const MDBTableName As String = ""
Dim wrkJet As DAO.Workspace
Dim DBS As DAO.Database
Dim RST As DAO.Recordset

                                ' MS PROJECT
Dim msacc As Object
Dim msexcel As Object
Dim MsProj As Object
'çàíåñåíèå ID â ïåðåìåííóþ id_6
id_6 = ActiveWorkbook.ActiveSheet.Cells(2, 11).Value
'Ïðèñàîåíèå äèàïàçîíîâ

If (UserForm1.TextBox1.Value <> "") And (UserForm1.TextBox2.Value <> "") Then
min_d = CInt(UserForm1.TextBox1.Value) 'InputBox("Ââåäèòå íà÷. äèàïàçîí")
max_d = CInt(UserForm1.TextBox2.Value) 'InputBox("Ââåäèòå êîí. äèàïàçîí")
End If
If (UserForm1.TextBox1.Value = "") And (UserForm1.TextBox2.Value = "") Then
min_d = 1 'InputBox("Ââåäèòå íà÷. äèàïàçîí")
max_d = ActiveProject.Tasks.Count 'InputBox("Ââåäèòå êîí. äèàïàçîí")
End If

'ïðîâåðêà äèàïàçîíà
If max_d > ActiveProject.Tasks.Count Then
MsgBox ("íå ïðàâèëüíî ââåäåí êîíå÷íûé äèàïàçîí")
Exit Sub
End If
If max_d - min_d < 0 Then
MsgBox ("Íåâåðíî çàäàíûäèàïàçîíû")
Exit Sub
End If

'ïðîâåðêà
al = ActiveProject.Tasks.Count
For i = min_d To max_d
On Error GoTo b:
If ActiveProject.Tasks(i).Start <> "" Then
If ActiveProject.Tasks(i).Text6 = CStr(id_6) Then
idnumber = i
GoTo a
End If
End If

Next i
MsgBox ("òàêîé ID íå íàéäåí")
Exit Sub

a:
'idnumber = 1 '302

                                    'ÌÎÄÅËÈÍÃ
'ïîëó÷àåì âðåìÿ ñòàðòà è êîíöà çàäàíèÿ
'a = ActiveProject.Tasks.Count
'b = ActiveProject.TaskTables.Count

idnumber = idnumber + 1
s = ActiveProject.Tasks(idnumber).Start
f = ActiveProject.Tasks(idnumber).Finish

'Îáðåçàåì äàòó è âðåìÿ
t1 = Left(s, 10)
t2 = Right(s, 8)
t3 = Left(f, 10)
t4 = Right(f, 8)

'Çàíîñèì â òàáëèöó ðåçóëüòàò
ActiveWorkbook.ActiveSheet.Cells(6, 7) = t1
ActiveWorkbook.ActiveSheet.Cells(6, 6) = t2
ActiveWorkbook.ActiveSheet.Cells(6, 12) = t3
ActiveWorkbook.ActiveSheet.Cells(6, 10) = t4

'Çàíåñíèå ðóñóðñà â òàáëèöó
r = ActiveProject.Tasks(idnumber).ResourceNames
ActiveWorkbook.ActiveSheet.Cells(7, 3) = r

'Çàíåñíèå äëèòåëüíîñòè â òàáëèöó
dur1_mod = ((ActiveProject.Tasks(idnumber).Duration) / 60)
ActiveWorkbook.ActiveSheet.Cells(6, 4) = dur1_mod


                                'ÒÅÊÑÒÓÐÈÍÃ
idnumber = idnumber + 1

s = ActiveProject.Tasks(idnumber).Start
f = ActiveProject.Tasks(idnumber).Finish
'Îáðåçàåì  äàòó è âðåìÿ

t1 = Left(s, 10)
t2 = Right(s, 8)
t3 = Left(f, 10)
t4 = Right(f, 8)
'Çàíîñèì â òàáëèöó ðåçóëüòàò
ActiveWorkbook.ActiveSheet.Cells(29, 8) = t1
ActiveWorkbook.ActiveSheet.Cells(29, 7) = t2
ActiveWorkbook.ActiveSheet.Cells(29, 11) = t3
ActiveWorkbook.ActiveSheet.Cells(29, 10) = t4
'Çàíåñíèå ðóñóðñà â òàáëèöó
r = ActiveProject.Tasks(idnumber).ResourceNames
ActiveWorkbook.ActiveSheet.Cells(30, 2) = r
dur1_mod = ActiveProject.Tasks(idnumber).Duration
ActiveWorkbook.ActiveSheet.Cells(29, 5) = dur1_mod

'Çàíåñíèå äëèòåëüíîñòè â òàáëèöó
dur1_mod = ((ActiveProject.Tasks(idnumber).Duration) / 60)
ActiveWorkbook.ActiveSheet.Cells(29, 5) = dur1_mod


If ploasd = 123 Then
b: MsgBox ("Óäàëèòå ïóñòûå  ñòðîêè")
End If
                                    ' MS ACCESS
  

  mdb = Sheets(2).Cells(1, 15).Value
    Set wrkJet = CreateWorkspace("wrkJet000", "Admin", "", dbUseJet)
  Set DBS = wrkJet.OpenDatabase(mdb, False, True)
  Set RST = DBS.OpenRecordset("Assets_sm_main_table")
  Dim X As Long, MaxX As Long, Y As Long
MaxX = RST.Fields.Count - 1
Do Until RST.EOF
 For X = 0 To MaxX
    If RST.Fields(X).Name = "ID" Then
          If RST.Fields(X) = id_6 Then
          Sheets(2).Cells(3, 5) = RST.Fields(X + 3)
          Sheets(2).Cells(2, 5) = RST.Fields(X + 2)
          Sheets(2).Cells(9, 3) = RST.Fields(X + 4)
          Sheets(2).Cells(32, 2) = RST.Fields(X + 4)
          End If
    End If
 Next X
 RST.MoveNext
 Loop
  RST.Close
  DBS.Close
  wrkJet.Close
End Sub

ошибка выделена

Добавлено через 9 минут и 10 секунд
кстати чуть чуть не рабочий скрипт... исправлял... там не прокатывает одна строка при удалении строки 
Код

 mdb = Sheets(2).Cells(1, 15).Value
, все работает.

кстати хотел бысь поинтересовать как можно сделать следующее... хочу прописать путь к базе скажем c:\temp\1.mdb в ячейку 1,1 что бы от туда брала и заносило в переменную mdb, у меня что то не прокатывает при обычном писвоении.
PM MAIL   Вверх
kapbepucm
Дата 24.10.2007, 12:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 3
Всего: 12
Хотелось бы русские комментарии почитать...


--------------------
(С) kapbepucm
PM MAIL Skype   Вверх
kall1sto
Дата 24.10.2007, 13:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
Код


Private Sub CommandButton1_Click()
Const MDBFileName As String = ""
Const MDBTableName As String = ""
Dim wrkJet As DAO.Workspace
Dim DBS As DAO.Database
Dim RST As DAO.Recordset

                                ' MS PROJECT
Dim msacc As Object
Dim msexcel As Object
Dim MsProj As Object
'занесение  ID в переменную id_6
id_6 = ActiveWorkbook.ActiveSheet.Cells(2, 11).Value
'Присвоение диапозонов
min_d = InputBox("Введите нач диапазон")
max_d = InputBox("Введите кон диапазон")
'Проверка диапазона
If max_d > ActiveProject.Tasks.Count Then
MsgBox ("не правильно ввдены диапазоны")
Exit Sub
End If
If max_d - min_d < 0 Then
MsgBox ("не правильно ввдены диапазоны")
Exit Sub
End If

'Проверка
al = ActiveProject.Tasks.Count
For i = min_d To max_d
On Error GoTo b:
If ActiveProject.Tasks(i).Start <> "" Then
If ActiveProject.Tasks(i).Text6 = CStr(id_6) Then
idnumber = i
GoTo a
End If
End If

Next i
MsgBox ("такой  ID не найден")
Exit Sub
a:

                                    'Задание 1

idnumber = idnumber + 1
 ' получаем время начала и конца задания
s = ActiveProject.Tasks(idnumber).Start
f = ActiveProject.Tasks(idnumber).Finish

'обрезаем дату и время
t1 = Left(s, 10)
t2 = Right(s, 8)
t3 = Left(f, 10)
t4 = Right(f, 8)

'зАНОСИМ В ТАБЛИЦУ РЕЗУЛЬТАТ
ActiveWorkbook.ActiveSheet.Cells(6, 7) = t1
ActiveWorkbook.ActiveSheet.Cells(6, 6) = t2
ActiveWorkbook.ActiveSheet.Cells(6, 12) = t3
ActiveWorkbook.ActiveSheet.Cells(6, 10) = t4

'Занесение ресурса в таблицу
r = ActiveProject.Tasks(idnumber).ResourceNames
ActiveWorkbook.ActiveSheet.Cells(7, 3) = r

'Занесение длительности в таблицу
dur1_mod = ((ActiveProject.Tasks(idnumber).Duration) / 60)
ActiveWorkbook.ActiveSheet.Cells(6, 4) = dur1_mod


                                'Задание 2
idnumber = idnumber + 1

s = ActiveProject.Tasks(idnumber).Start
f = ActiveProject.Tasks(idnumber).Finish
'обрезаем дату и время

t1 = Left(s, 10)
t2 = Right(s, 8)
t3 = Left(f, 10)
t4 = Right(f, 8)
'Заносим в таблицу результат
ActiveWorkbook.ActiveSheet.Cells(29, 8) = t1
ActiveWorkbook.ActiveSheet.Cells(29, 7) = t2
ActiveWorkbook.ActiveSheet.Cells(29, 11) = t3
ActiveWorkbook.ActiveSheet.Cells(29, 10) = t4
'Занесение ресурса в таблицу
r = ActiveProject.Tasks(idnumber).ResourceNames
ActiveWorkbook.ActiveSheet.Cells(30, 2) = r
dur1_mod = ActiveProject.Tasks(idnumber).Duration
ActiveWorkbook.ActiveSheet.Cells(29, 5) = dur1_mod
'Занесение длительности в таблицу
dur1_mod = ((ActiveProject.Tasks(idnumber).Duration) / 60)
ActiveWorkbook.ActiveSheet.Cells(29, 5) = dur1_mod

MsgBox ("ok")
If ploasd = 123 Then
b: MsgBox ("Удалите пустые строки")
End If
                                    ' MS ACCESS
  

  
  Set wrkJet = CreateWorkspace("wrkJet000", "Admin", "", dbUseJet)
  Set DBS = wrkJet.OpenDatabase("Путь к базе полностью типа c:\asd\", False, True)
  Set RST = DBS.OpenRecordset("Assets_sm_main_table")
  Dim X As Long, MaxX As Long, Y As Long
   
'z_a = 0


 

MaxX = RST.Fields.Count - 1
Do Until RST.EOF
 For X = 0 To MaxX
    If RST.Fields(X).Name = "ID" Then
          If RST.Fields(X) = id_6 Then
          Sheets(2).Cells(3, 5) = RST.Fields(X + 3)
          Sheets(2).Cells(2, 5) = RST.Fields(X + 2)
          Sheets(2).Cells(9, 3) = RST.Fields(X + 4)
          Sheets(2).Cells(32, 2) = RST.Fields(X + 4)
          End If
    End If
 Next X
 RST.MoveNext
 Loop
    RST.Close
  DBS.Close
  wrkJet.Close
End Sub

Во такого плана получается на моей машинке работает правда долго, так как в проджекте около 15000 записей(мот можно как нить упростить). На другой машинке ошибка на код Activproject (хотя проект открыт, библиотека проджекта подключена, макросы включены).
PM MAIL   Вверх
kapbepucm
Дата 24.10.2007, 14:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 3
Всего: 12
ActiveProject точно открыт?
Код, я считаю, довольно запутанный... До конца я не понял, что вообще требуется от кода сделать (Выбрать записи из определённого диапазона и перекинуть в Excel?) Там некоторые строки стоят, вообще не понимаю, зачем?
Код
Dim msacc As Object
Dim msexcel As Object
Dim MsProj As Object
'------------------
al = ActiveProject.Tasks.Count
А этим
Цитата(kall1sto @  19.10.2007,  09:11 Найти цитируемый пост)
причем без использования sql
можно пренебречь?
Цитата(kall1sto @  24.10.2007,  13:15 Найти цитируемый пост)
мот можно как нить упростить
Если построчно обращаться к таблице, то будет тормозить.
Цитата(kall1sto @  24.10.2007,  10:41 Найти цитируемый пост)
хочу прописать
Что типа того?:
Код
Dim mdb1 As String, mdb2 As String
mdb2 = "c:\temp\1.mdb"
mdb1 = Sheets(1).Cells(1, 1)
MsgBox mdb1
Sheets(1).Cells(1, 1) = mdb2


Это сообщение отредактировал(а) kapbepucm - 24.10.2007, 14:46


--------------------
(С) kapbepucm
PM MAIL Skype   Вверх
kall1sto
Дата 24.10.2007, 14:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
Вообщем скрипт работает так:
1. На листе ехсel пользователь вводит ID, этот ID ищется в проджекте (и зансится в ехсel) данные по задаче с таким ID, заносятся в excel, то же самое в access находится  запись с таким же Id нежно изначально найти ее затем тоже перенести в excel отдельные ячейки этой строки.
2. Принебречь можно, но я боюсь что не разберусь. ( если можно с комментом.
3. а актив проджект точно открыт, я ж не такой уж плуг...
4. плюс добавить туда :
Код

Dim mdb1 As String, mdb2 As String
mdb2 = "c:\temp\1.mdb"
mdb1 = Sheets(1).Cells(1, 1)
MsgBox mdb1
Sheets(1).Cells(1, 1) = mdb2

типо того...
PM MAIL   Вверх
kapbepucm
Дата 24.10.2007, 15:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 3
Всего: 12
Может теперь я ступлю: о каком подключённом проекте идёт речь?

Это сообщение отредактировал(а) kapbepucm - 24.10.2007, 15:24


--------------------
(С) kapbepucm
PM MAIL Skype   Вверх
kall1sto
Дата 24.10.2007, 15:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
ну синтаксис обращения к проджекту ActiveProject.task для него нужна библиотека Microsoft Project library ?.??
PM MAIL   Вверх
kall1sto
Дата 24.10.2007, 15:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
Цитата

код Visual Basic 
Dim msacc As Object
Dim msexcel As Object
Dim MsProj As Object
'------------------
al = ActiveProject.Tasks.Count
 

по поводу строк, там просто были другие варианты этого скрипта куча закаментированного, когда оформлял на форуме стирал, а это ускользнуло
PM MAIL   Вверх
kapbepucm
Дата 24.10.2007, 16:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 3
Всего: 12
Для ускорения советую использовать нечто подобное:
Код
Const MDBFileName As String = ""
Dim wrkJet As DAO.Workspace
Dim DBS As DAO.Database
Dim RST As DAO.Recordset
Set wrkJet = CreateWorkspace("wrkJet000", "Admin", "", dbUseJet)
Set DBS = wrkJet.OpenDatabase(MDBFileName, False, True)
Set RST = DBS.OpenRecordset("Select * From Assets_sm_main_table Where Assets_sm_main_table.ID=""" & id_6 & """")
dim MaxX as long, X as long
MaxX = RST.Fields.Count - 1
For X = 0 To MaxX
  If RST.Fields(X).Name = "ID" Then
    Sheets(2).Cells(3, 5) = RST.Fields(X + 3)
    Sheets(2).Cells(2, 5) = RST.Fields(X + 2)
    Sheets(2).Cells(9, 3) = RST.Fields(X + 4)
    Sheets(2).Cells(32, 2) = RST.Fields(X + 4)
    exit for
  End If
Next X
RST.Close
DBS.Close
wrkJet.Close
не надо будет проходить по всем записям. Как я понял, нужна одна запись из таблицы Access'a.

Отредактировано.

Это сообщение отредактировал(а) kapbepucm - 24.10.2007, 22:01


--------------------
(С) kapbepucm
PM MAIL Skype   Вверх
kall1sto
Дата 24.10.2007, 17:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 42
Регистрация: 19.10.2007

Репутация: нет
Всего: нет
Run time error '3075':
Ошибка синтаксиса (пропущен оператор) в выражении запроса '*.Assets_sm_main_table'.(блин говорил траблы будут потому что явно какой нить символ добавть и все заработает, но я sql вообще не знаю.)
на строке 7 твоего кода ...
и еще мот надо еще какая нить библиотека для запросов sql?
кстати раньше была загвоздка с форматом accdb ( я тогда в коде писал mdb, а открывал accdb? тогда работало, сейчас нет пршлось сохранить в формате mdb.
PM MAIL   Вверх
Akina
Дата 24.10.2007, 18:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454
kall1sto, замени на
Код

Set RST = DBS.OpenRecordset("Select * From Assets_sm_main_table Where ID=""" & id_6 & """")



--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.
PM MAIL WWW ICQ Jabber   Вверх
kapbepucm
Дата 25.10.2007, 09:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

Репутация: 3
Всего: 12
Похоже есть ещё нестабильное место: это строки 97-99. C тем же успехом можно было-бы писать
Код
if false then
Вообще, обработчика ошибок я бы писал так, что-бы он не мешал основному коду (используя, например, Exit Sub в нём). Тогда общий код мог-бы выглядеть примерно так
Код
Private Sub CommandButton1_Click()
  Const MDBFileName As String = "полный путь к базе"
  Dim wrkJet As DAO.Workspace
  Dim DBS As DAO.Database
  Dim RST As DAO.Recordset
  Dim id_6 As Variant
  Dim min_d As Long, max_d As Long 'границы диапазона
  Dim I As Long
  Dim idnumber As Long
  Dim s As String, f As String 'время начала и конца задания
  Dim X As Long, MaxX As Long
'-----------------------------------------------------------
                                ' MS PROJECT
'-----------------------------------------------------------
  'занесение  ID в переменную id_6
  id_6 = ActiveWorkbook.ActiveSheet.Cells(2, 11).Value
  'присвоение диапазонов
  min_d = InputBox("начальный диапазон")
  max_d = InputBox("конечный диапазон")
  'проверка диапазона
  If ((max_d > ActiveProject.Tasks.Count) Or (max_d - min_d < 0)) Then
    MsgBox ("неправильно введены диапазоны")
    Exit Sub
  End If
  'проверка
  For I = min_d To max_d
    On Error GoTo b
    If (ActiveProject.Tasks(I).Start <> "") And (ActiveProject.Tasks(I).Text6 = CStr(id_6)) Then
      idnumber = I
      On Error GoTo 0
      GoTo a
    End If
  Next I
  MsgBox ("такой  ID не найден")
  Exit Sub
a:
'------------------------------------------------------------
'                            задание 1
'------------------------------------------------------------
  idnumber = idnumber + 1
  'получаем время начала и конца задания
  s = ActiveProject.Tasks(idnumber).Start
  f = ActiveProject.Tasks(idnumber).Finish
  'обрезаем дату и время и заносим в таблицу результат
  ActiveWorkbook.ActiveSheet.Cells(6, 7) = Left(s, 10)
  ActiveWorkbook.ActiveSheet.Cells(6, 6) = Right(s, 8)
  ActiveWorkbook.ActiveSheet.Cells(6, 12) = Left(f, 10)
  ActiveWorkbook.ActiveSheet.Cells(6, 10) = Right(f, 8)
  'занесение ресурса в таблицу
  ActiveWorkbook.ActiveSheet.Cells(7, 3) = ActiveProject.Tasks(idnumber).ResourceNames
  'занесение длительности в таблицу
  ActiveWorkbook.ActiveSheet.Cells(6, 4) = ((ActiveProject.Tasks(idnumber).Duration) / 60)
'-------------------------------------------------------------
                                'задание 2
'-------------------------------------------------------------
  idnumber = idnumber + 1
  s = ActiveProject.Tasks(idnumber).Start
  f = ActiveProject.Tasks(idnumber).Finish
  'обрезаем дату и время и заносим в таблицу результат
  ActiveWorkbook.ActiveSheet.Cells(29, 8) = Left(s, 10)
  ActiveWorkbook.ActiveSheet.Cells(29, 7) = Right(s, 8)
  ActiveWorkbook.ActiveSheet.Cells(29, 11) = Left(f, 10)
  ActiveWorkbook.ActiveSheet.Cells(29, 10) = Right(f, 8)
  'занесение ресурса в таблицу
  ActiveWorkbook.ActiveSheet.Cells(30, 2) = ActiveProject.Tasks(idnumber).ResourceNames
  ActiveWorkbook.ActiveSheet.Cells(29, 5) = ActiveProject.Tasks(idnumber).Duration
  'занесение длительности в таблицу
  ActiveWorkbook.ActiveSheet.Cells(29, 5) = ((ActiveProject.Tasks(idnumber).Duration) / 60)
  MsgBox ("ok")
  If False Then
b:
    Err.Clear
    MsgBox Err.Description, vbCritical, "ERROR"
    MsgBox ("Удалите пустые строки")
    Exit Sub
  End If
'-------------------------------------------------------------
                          ' MS ACCESS
'-------------------------------------------------------------
  Set wrkJet = CreateWorkspace("wrkJet000", "Admin", "", dbUseJet)
  Set DBS = wrkJet.OpenDatabase(MDBFileName, False, True)
  Set RST = DBS.OpenRecordset("Select * From Assets_sm_main_table Where Assets_sm_main_table.ID=""" & id_6 & """")
  MaxX = RST.Fields.Count - 1
  For X = 0 To MaxX
    If RST.Fields(X).Name = "ID" Then
      Sheets(2).Cells(3, 5) = RST.Fields(X + 3)
      Sheets(2).Cells(2, 5) = RST.Fields(X + 2)
      Sheets(2).Cells(9, 3) = RST.Fields(X + 4)
      Sheets(2).Cells(32, 2) = RST.Fields(X + 4)
      Exit For
    End If
  Next X
  RST.Close
  DBS.Close
  wrkJet.Close
End Sub


Это сообщение отредактировал(а) kapbepucm - 25.10.2007, 09:54


--------------------
(С) kapbepucm
PM MAIL Skype   Вверх
Страницы: (4) Все 1 [2] 3 4 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Программирование, связанное с MS Office"
mihanik staruha

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами


  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • Оставляйте свои записи в "Книге отзывов о работе администрации"
  • А вот тут лежит FAQ нашего подраздела

Если Вам понравилась атмосфера форума, заходите к нам чаще!
С уважением mihanik и staruha.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0989 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.