ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / dll-библиотеки, копии книг
19 сообщений из 44, страница 2 из 2
  2  все
dll-библиотеки, копии книг
    #34854011
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
nPUBET
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
     
    rng.Copy
    ThisWorkbook.Worksheets("Kyda").Range("A1").PasteSpecial xlPasteValues
    ThisWorkbook.Worksheets("Kyda").Range("A1").PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    '********
    Dim rngB As Range
    Set rngB = xlWb.Worksheets("ucx").Range("C:C")
    rngB.Copy
    ThisWorkbook.Worksheets("Kyda").Range("C1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False ' очистка буфера
    Set rngB = Nothing
    '********

    Set rng = Nothing
    xlWb.Close False
    Set xlWb = Nothing
    ThisWorkbook.Worksheets("Kyda").Range("A1").Select  ' т.к. после выполнения макроса вся таблица остается выделенной
    Application.ScreenUpdating = True
    mReferens
End Sub

Хотя стоят =Nothing=, перед запуском алгоритма появляется сообщение:
"У Вас в буфере куча информации. Хотите вставить эти данные где-нибудь?"

Как сделать, чтобы это сообщение не появлялось?

смотри строку
Application.CutCopyMode = False ' очистка буфера
...
Рейтинг: 0 / 0
08.10.2007, 14:01:49
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34854049
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
vkodor...
смотри строку
Application.CutCopyMode = False ' очистка буфера
Большое спасибо!
...думаю, мне нужно для надёжности:
после каждого =PasteSpecial= или =rng.Copy Destination:=ThisWorkbook.Worksheets...=,
всегда ставить в следующей строке такое выражение:

Код: plaintext
Application.CutCopyMode = False
...
Рейтинг: 0 / 0
08.10.2007, 14:14:01
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34854516
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
Код: plaintext
1.
2.
3.
4.
5.
    With Button
        .Caption = "Сохранить все книги"
        .Style = msoButtonIcon
        .OnAction = "SaveBook1" & "SaveBook2"  '  здесь ошибка
       ' .OnAction = "SaveBook1", "SaveBook2"  '  здесь ошибка
    End With

Подскажите, пожалуйста, как сделать, чтобы при нажатии кнопки "Сохранить все книги" запускались 2 макроса поочерёдно.
Т.е хотел бы прикрепить к =.OnAction= названия 2-х макросов.
...
Рейтинг: 0 / 0
08.10.2007, 16:09:43
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34854719
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
nPUBET
Код: plaintext
1.
2.
3.
4.
5.
    With Button
        .Caption = "Сохранить все книги"
        .Style = msoButtonIcon
        .OnAction = "SaveBook1" & "SaveBook2"  '  здесь ошибка
       ' .OnAction = "SaveBook1", "SaveBook2"  '  здесь ошибка
    End With

Подскажите, пожалуйста, как сделать, чтобы при нажатии кнопки "Сохранить все книги" запускались 2 макроса поочерёдно.
Т.е хотел бы прикрепить к =.OnAction= названия 2-х макросов.
Так не получится.
сделай макрос который будет запускать твои два
Код: plaintext
1.
2.
3.
Sub temp()
    Application.Run "Module1.SaveBook1"
    Application.Run "Module1.SaveBook2"
End Sub
а кнопке присвой этот созданный макрос
Код: plaintext
.OnAction "temp"
...
Рейтинг: 0 / 0
08.10.2007, 17:01:04
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34854888
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
vkodor
....Так не получится.
сделай макрос который будет запускать твои два
Код: plaintext
1.
2.
3.
Sub temp()
    Application.Run "Module1.SaveBook1"
    Application.Run "Module1.SaveBook2"
End Sub
а кнопке присвой этот созданный макрос
Код: plaintext
.OnAction "temp"

Большое спасибо!

Работает...
...
Рейтинг: 0 / 0
08.10.2007, 17:53:38
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34861093
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
Sub TOMAT452()
 Application.ScreenUpdating = False
 
    Dim xlWb As Workbook
    Dim rng As Range
    Dim ishFile As String
    Sheets("452").Activate
    '********
    ishFile = ThisWorkbook.Path & ActiveWorkbook.Sheets("A3").Range("B1").Value
    Set xlWb = Workbooks.Open(ishFile, False, True)
    Set rng = xlWb.Worksheets("452").Range("D1:D10")
    
    '***************************************************
'     Dim iPT As Long
'     Dim iNo As Long
'
'        iKOT = rng.Range("1:1").Find("KOT", LookIn:=xlFormulas, LookAt:= _
'        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
'
'        iCH = rng.Range("1:1").Find("OC-H", LookIn:=xlFormulas, LookAt:= _
'        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    
    
    '********
    rng.Copy
    ThisWorkbook.Worksheets("452").Range("N11").PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
    '********
    
    Set rng = Nothing
    xlWb.Close False
    Set xlWb = Nothing

    '*******
    Range("A1").Select
    
    Application.ScreenUpdating = True
    mReferens
End Sub

Пытаюсь соорудить следующее:
1. Иду в файл =452.xls=
2. Иду в 1-ую строку. Ищу столбцы с названиями "KOT и "OC-H".
3. Присваиваю им номера iKOT и iOC.
4. Перехожу в файл =Кyda.xls=.
5. Иду в строку, в которой с 1-го столбца по 5-й столбец есть текст.
6. Ищу в найденной строке названия столбцa =ABTO=.
7. Присваиваю ему номер iABT.
8. Если значение в столбце iOC равно значению в столбце iABT, тогда копирую значение iKOT
9. перехожу в файл =Kyda.xls=, лист =452= и вставляю скопированную ячейку в столбец N, начиная с N11 (т.е. в ту строку, где значения в столбцах iOC, iABT одинаковые).
10. если в столбце iKOT значение ячейки пустое (или равно 0), тогда эту строку в файле =452.xls= не сравниваю, не копирую, т.е. прохожу мимо, игнорирую.

Подскажите, пожалуйста, как это построить.
...
Рейтинг: 0 / 0
10.10.2007, 17:15:11
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34861101
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
Вот файл, откуда копирую ячейки.
...
Рейтинг: 0 / 0
10.10.2007, 17:16:24
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34862318
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
Sub TOMAT452()
    Dim xlWb As Workbook
    Dim rng As Range
    Dim ishFile As String
     Dim iKOT As Long
     Dim iOC As Long
     Dim iABT As Long
    Dim nSh As String
    Dim i As Long
    'для отмены мелькания на экране
    Application.ScreenUpdating = False
'    Sheets("452").Activate
    '********
    'берем название обрабатываемого листа с ячейки "B1" листа "A3" этой книги
    nSh = CStr(ThisWorkbook.Sheets("A3").Range("B1").Value)
    'берем название файла с ячейки "B1" листа "A3" _
    (т.к. мы установили в ячейке нужный формат и храним в значение только название без расширения то надо брать text)
    ishFile = ThisWorkbook.Path & ThisWorkbook.Sheets("A3").Range("B1").Text
    'проверка существования файла
    If Dir(ishFile, vbNormal) = "" Then
        MsgBox "Проверьте путь и файл"
        Exit Sub
    End If
    'открытие файла
    Set xlWb = Workbooks.Open(ishFile, False, True)
    ' поиск столбца "KOT"
    Set rng = xlWb.Worksheets(CStr(ThisWorkbook.Sheets("A3").Range("B1"))).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True)
    If rng Is Nothing Then
        Set rng = Nothing
        xlWb.Close
        Set xlWb = Nothing
        MsgBox "Не найден столбец ""KOT""", vbCritical, "Проверка"
        Exit Sub
    Else
        iKOT = rng.Column
    End If
    ' поиск столбца "OC-H"
    Set rng = xlWb.Worksheets( 1 ).Cells.Find("OC-H", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If rng Is Nothing Then
        Set rng = Nothing
        xlWb.Close
        Set xlWb = Nothing
        MsgBox "Не найден столбец ""OC-H""", vbCritical, "Проверка"
        Exit Sub
    Else
        iOC = rng.Column
    End If
    ' поиск столбца "ABTO"
    Set rng = ThisWorkbook.Worksheets(nSh).Cells.Find("ABTO", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If rng Is Nothing Then
        Set rng = Nothing
        xlWb.Close
        Set xlWb = Nothing
        MsgBox "Не найден столбец ""ABTO""", vbCritical, "Проверка"
        Exit Sub
    Else
        iABT = rng.Column
    End If
    ' определяем нижнюю ячейку в столбце "OC-H"
    nisiOC = xlWb.Worksheets( 1 ).Cells(Rows.Count, iOC).End(xlUp).Row
    ' определяем нижнюю ячейку в столбце "ABTO"
    nisiABT = ThisWorkbook.Worksheets(nSh).Cells(Rows.Count, iABT).End(xlUp).Row
    '***************************************************
    For i =  2  To nisiOC 'делаем пробег по столбцу "iOC" со второй строки по "nisiOC"
        With ThisWorkbook.Worksheets(nSh)
            'проверка есть ли значение в столбце "KOT" и "iOC"
            If xlWb.Worksheets( 1 ).Cells(i, iOC) <> "" And _
                xlWb.Worksheets( 1 ).Cells(i, iKOT) <> "" Then
                ' ищем значение столбца "OC-H" в столбце "ABTO"
                Set rng = .Range(.Cells( 2 , iABT), .Cells(nisiABT, iABT)).Find( _
                    xlWb.Worksheets( 1 ).Cells(i, iOC), _
                    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=True)
                'проверка найдено ли значение
                If Not rng Is Nothing Then
'                    rng.Copy
'                    ThisWorkbook.Worksheets("452").Cells(rng.Row, "N").PasteSpecial xlPasteValues
                    'т.к. нужно только значение то не будем использовать метод "Copy"
                    ThisWorkbook.Worksheets("452").Cells(rng.Row, "N") = _
                        xlWb.Worksheets( 1 ).Cells(i, iKOT) ' название листа стоит сделать переменной

                End If
            End If
        End With
    Next

    Set rng = Nothing
    xlWb.Close False
    Set xlWb = Nothing

    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
11.10.2007, 10:54:28
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34862639
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
vkodor
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Sub TOMAT452()
    Dim xlWb As Workbook
    Dim rng As Range
    Dim ishFile As String
     Dim iKOT As Long
     ......
                End If
            End If
        End With
    Next

    Set rng = Nothing
    xlWb.Close False
    Set xlWb = Nothing

    Application.ScreenUpdating = True
End Sub


vkodor
спасибо!
Большое спасибо!
...
Рейтинг: 0 / 0
11.10.2007, 11:55:57
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864108
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
Код: plaintext
1.
2.
3.
    Set rng = xlWb.Worksheets(ThisWorkbook.Sheets("A3").Range("B1")).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True)  ' <==  выделяет жёлтым цветом, ошибка 9

поменял =B1= на =B2=.
Появляется ошибка 9.
Т.е. с листа =468= не получается скопировать ячейки с =K=.

Как исправить ошибку?
...
Рейтинг: 0 / 0
11.10.2007, 17:52:09
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864146
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
Sub TOMAT452()
    Dim xlWb As Workbook
    Dim rng As Range
    Dim ishFile As String
     Dim iKOT As Long
     Dim iOC As Long
     Dim iABT As Long
    Dim nSh As String
    Dim i As Long
    'для отмены мелькания на экране
    Application.ScreenUpdating = False
'    Sheets("452").Activate
    '********
    'берем название обрабатываемого листа с ячейки "B2" листа "A3" этой книги
    nSh = CStr(ThisWorkbook.Sheets("A3").Range("B2").Value)
    'берем название файла с ячейки "B2" листа "A3" _
   '  (т.к. мы установили в ячейке нужный формат и храним в значение только название без расширения то надо брать text)
    ishFile = ThisWorkbook.Path & ThisWorkbook.Sheets("A3").Range("B2").Text
    'проверка существования файла
    If Dir(ishFile, vbNormal) = "" Then
        MsgBox "Проверьте путь и файл"
        Exit Sub
    End If
    'открытие файла
    Set xlWb = Workbooks.Open(ishFile, False, True)
    ' поиск столбца "KOT"
'********** ошибка 9
Set rng = xlWb.Worksheets(CStr(ThisWorkbook.Sheets("A3").Range("B2"))).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True) ' <== ошибка 9
'********** ошибка 9

здесь '***** ошибка 9
...
Рейтинг: 0 / 0
11.10.2007, 18:02:52
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864177
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
перед
Код: plaintext
1.
2.
3.
4.
'********** ошибка 9
Set rng = xlWb.Worksheets(CStr(ThisWorkbook.Sheets("A3").Range("B2"))).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True) ' <== ошибка 9
'********** ошибка  9
поставь
Код: plaintext
1.
msgbox CStr(ThisWorkbook.Sheets("A3").Range("B2"))
msgbox ThisWorkbook.Sheets("A3").Range("B2")
И посмотри что выводится?
...
Рейтинг: 0 / 0
11.10.2007, 18:12:47
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864188
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
Изменил =452= на =А452=.
Ошибка 9.

"\"0".xls"

Как вместо =0= вводить текст?
...
Рейтинг: 0 / 0
11.10.2007, 18:16:07
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864204
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
измени формат в ячейке "В2" листа "А3"
сделай его таким-же как в ячейке "В1"
и впиши туда не формулу
Код: plaintext
="\"&A2&".xls"
а просто 468
...
Рейтинг: 0 / 0
11.10.2007, 18:19:33
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864209
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
а вместо
Код: plaintext
1.
2.
    Set rng = xlWb.Worksheets(CStr(ThisWorkbook.Sheets("A3").Range("B1"))).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True)
напиши
Код: plaintext
1.
2.
    Set rng = xlWb.Worksheets(nSh).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True)
...
Рейтинг: 0 / 0
11.10.2007, 18:22:38
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864348
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
vkodorа вместо
Код: plaintext
1.
2.
    Set rng = xlWb.Worksheets(CStr(ThisWorkbook.Sheets("A3").Range("B1"))).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True)
напиши
Код: plaintext
1.
2.
    Set rng = xlWb.Worksheets(nSh).Cells.Find( _
        "KOT", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=True)


Поменял. Не работает.
У меня проблемы с форматом. Вместо =452= поставил =А452=.
Т.е. "\"0".xls" не читает текст ().
...
Рейтинг: 0 / 0
11.10.2007, 19:41:31
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864359
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
...
Рейтинг: 0 / 0
11.10.2007, 19:46:46
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34864395
nPUBET
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nPUBET
Гость
vkodor

Большое спасибо за поддержку!
По различным причинам смогу вернутся к этому топику месяца через два (если повезёт).
...
Рейтинг: 0 / 0
11.10.2007, 20:13:30
| Ответить | Цитировать | Написать  
dll-библиотеки, копии книг
    #34865398
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
nPUBETУ меня проблемы с форматом. Вместо =452= поставил =А452=.
Т.е. "\"0".xls" не читает текст ().
вместо 0 надо @
пример: "\"@".xls"
...
Рейтинг: 0 / 0
12.10.2007, 15:06:18
| Ответить | Цитировать | Написать  
19 сообщений из 44, страница 2 из 2
  2  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / dll-библиотеки, копии книг
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&gotonew=1&tid=2182115]:
 0ms
get settings:
 9ms
get forum list:
 11ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 50ms
get topic data:
 8ms
get first new msg:
 5ms
get forum data:
 2ms
get page messages:
 50ms
get tp. blocked users:
 1ms
others: 209ms
total:  349ms
созд. / загр.: 349ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]