Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.86/81: Рейтинг темы: голосов - 81, средняя оценка - 4.86
Ник Харди
1 / 1 / 0
Регистрация: 13.03.2010
Сообщений: 4
1

Обращение к ячейкам открытой книги (не текущей)

30.01.2012, 15:02. Просмотров 16743. Ответов 6
Метки нет (Все метки)

Макрос должен запускаться, спрашивать - какой файл ему взять.
Открыть его, разделить определенную ячейку на 1000, сохранить файл.

Как это сделать? А то я глючу.

Visual Basic
1
2
listname = "Топливо форма"
ActiveWorkbook.Sheets(listname).Cells = ActiveWorkbook.Sheets(listname).Cells / 1000
не работает, т.к. ActiveWorkBook это, почему-то, книга, из которой запущен макрос. А не та, которая открыта этим макросом.

Как это побороть. Как обратится именно к нужной, открытой книге?
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
30.01.2012, 15:02
Ответы с готовыми решениями:

Обращение по определенному адресу к ячейкам для любой книги
Всем привет. У меня есть куча разных книг в которых используются листы с одинаковыми названиями...

Считать значение из открытой книги
Доброго времени суток , помогите написать макрос на открытие файла экселя для того что бы взять...

Бэкап открытой книги Excel
Всем привет! Может кто мне подскажет, как с помощью ВБА сделать бэкап открытой книги эксель. у нас...

Данные из другой открытой книги
Есть Книга1 (поля "наименование" и "цена") и Книга2, с идентичными полями. Необходимо в Книге2...

Экспорт функции из другой открытой книги
Нужна помощь.Есть две открытые книги. В 1ой написан макрос и функция. 2ая пустая, та книга, в...

6
toiai
3181 / 936 / 216
Регистрация: 29.05.2010
Сообщений: 2,038
30.01.2012, 17:31 2
Если на указанном листе курсор установлен на той ячейке, что нужно тебе, то:

Visual Basic
1
2
Sheets(listname).Activate
ActiveCell.Value=ActiveCell.Value/1000
0
Dragokas
Эксперт WindowsАвтор FAQ
17127 / 7181 / 864
Регистрация: 25.12.2011
Сообщений: 10,971
Записей в блоге: 16
30.01.2012, 18:45 3
Visual Basic
1
2
3
4
5
6
7
8
9
Sub aa()
Dim cell
Application.Dialogs(xlDialogOpen).Show "*.xls"
If ThisWorkbook.Name = ActiveWorkbook.Name Then Exit Sub
For Each cell In ActiveWorkbook.ActiveSheet.UsedRange 'или вместо Usedrange - Range("...")
    If Len(cell) <> 0 Then cell.Value = cell.Value / 1000
Next
ActiveWorkbook.Close True
End Sub

Цитата Сообщение от Ник Харди Посмотреть сообщение
ActiveWorkBook это, почему-то, книга, из которой запущен макрос
Не путайте, ActiveWorkBook - это обращение к книге, которая находится у Вас перед глазами и активна (на то она и Active...).
Обращаться к книге с макросом (если активна другая книга) можно через команду ThisWorkBook.
0
Busine2012
1297 / 399 / 22
Регистрация: 21.10.2011
Сообщений: 1,285
31.01.2012, 16:16 4
Ник Харди,
надо обращаться к книгам через переменные.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Процедура1()
    Dim objWorkbook As Excel.Workbook
    Dim strWorkbookName As String
    'С помощью msoFileDialogFilePicker просто помещаем
    'в переменную strWorkbookName имя выбранного файла.
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        strWorkbookName = .SelectedItems(1)
    End With
    'А здесь уже открываем выбранный файл и связываем его
    'с переменной objWorkbook, через которую
    'и будем работать с выбранным файлом.
    Set objWorkbook = Workbooks.Open(Filename:=strWorkbookName)
    objWorkbook.Worksheets(1).Cells(1, 1).Value = "text"
End Sub
0
Ник Харди
1 / 1 / 0
Регистрация: 13.03.2010
Сообщений: 4
31.01.2012, 16:55  [ТС] 5
Всё заработало, будучи дописанным самостоятельно.

Вот полный текст макроса (включая progress bar)

Visual Basic
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
Public path As String, jFirst As Integer, jEnd As Integer, steping As String, FirstCell As Integer, EndCell As Integer, listname As String
Public file As String, i As Integer, FinalList As Integer, СчетчикПрогресса As Integer, ifInteger As String, StepInt As Integer
Public CounterNotRed As Integer, pctdone As Single, CounterAll As Integer, СчетчикОбработанныхФайлов2 As Integer
Sub UpdateProgress(Pct)
    With UserForm1
        .FrameProgress.Caption = Format(Pct, "0%")
        .LabelProgress.Width = Pct * (.FrameProgress.Width - 10)
        .Repaint
    End With
End Sub
 
Sub ShowUserForm()
With UserForm1
    .LabelProgress.Width = 0
    .Show
End With
End Sub
 
 
Sub Transport_from_1()
    
СчетчикПрогресса = 0
  CounterAll = 0
  CounterNotRed = 0
  СчетчикОбработанныхФайлов2 = 0
  
 
 
    With Application
'отлючаем обновление экрана - это убыстрит работу макроса
.ScreenUpdating = False
'отключаем отображения окон на панели задач на время выполнения макроса
.ShowWindowsInTaskbar = False
.DisplayAlerts = True
    End With
 
   With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку": .Show
        If .SelectedItems.Count = 0 Then
            Unload UserForm1
            Exit Sub
        Else
            path = .SelectedItems(1) & "\"
        End If
    End With
    
    
     With CreateObject("Scripting.FileSystemObject")
        CounterAll = .GetFolder(path).Files.Count * 5
    End With
 
    file = Dir(path & "*.xlsm")
    Do While file <> ""
        Application.Workbooks.Open (path & "\" & file)
 
        'Задаем значения: с какого по какой столбец нужно заполнять.
        'Также прописываем шаг (step) - через сколько строк скакать. Не через сколько.
        listname = "Топливо форма"
        jFirst = 6
        jEnd = 17
        StepInt = 5
 
        Call Svoyo
        Call CounterUpdate
       
        
        Call CounterUpdate
            
'Сохранение книги в текущую папку под новым именем
ActiveWorkbook.SaveAs ThisWorkbook.path & "\" & file & "_1.1.xlsm"
ActiveWorkbook.Close (savechanges = False)
          file = Dir
    Loop
    
    
    Application.DisplayAlerts = True
    Unload UserForm1
MsgBox "Работа макроса завершена успешно." & Chr(13) & "Обработано файлов: " & СчетчикОбработанныхФайлов2
ThisWorkbook.Close (savechanges = False)
ActiveWorkbook.Close (savechanges = False)
 
 
 
End Sub
 
Sub Svoyo()
'Задаем имя листа - Тепло Своё
listname = "Топливо форма"
 
 
'Котёл 1
        FirstCell = 80: EndCell = 110
        Summer
 
 
 'Котёл 2
    FirstCell = 119: EndCell = 149
        Summer
  
  'Котёл 3
  
      FirstCell = 158: EndCell = 188
        Summer
  'Котёл 4
  
      FirstCell = 197: EndCell = 227
        Summer
        
Call CounterUpdate
  
    
  'Котёл 5
  
      FirstCell = 236: EndCell = 266
        Summer
        
        
  'Котёл 6
  
      FirstCell = 275: EndCell = 305
        Summer
        
        
  'Котёл 7
      FirstCell = 314: EndCell = 344
        Summer
        
  'Котёл 8
      FirstCell = 353: EndCell = 383
        Summer
        
Call CounterUpdate
  
  
  'Котёл 9
  
      FirstCell = 392: EndCell = 422
        Summer
  'Котёл 10
  
      FirstCell = 431: EndCell = 461
        Summer
  
           
    
        
Call CounterUpdate
         СчетчикОбработанныхФайлов2 = СчетчикОбработанныхФайлов2 + 1
 
End Sub
Sub Summer()
    Dim j As Integer, temp As Integer
      temp = 0
       For j = jFirst To jEnd
            For k = FirstCell To EndCell Step StepInt
             ActiveWorkbook.Sheets(listname).Cells(k, j) = ActiveWorkbook.Sheets(listname).Cells(k, j) / 1000
            Next k
        Next j
    
End Sub
  
 
 
 
 
Sub CounterUpdate()
 
     СчетчикПрогресса = СчетчикПрогресса + 1
      pctdone = СчетчикПрогресса / CounterAll
      Call UpdateProgress(pctdone)
     
End Sub
1
Dragokas
Эксперт WindowsАвтор FAQ
17127 / 7181 / 864
Регистрация: 25.12.2011
Сообщений: 10,971
Записей в блоге: 16
31.01.2012, 20:17 6
Visual Basic
1
2
ThisWorkbook.Close (savechanges = False)
ActiveWorkbook.Close (savechanges = False)
У Вас в этом порядке книга с макросом не закроется.

Попробуйте в обратном порядке или так:
Visual Basic
1
2
ActiveWorkbook.Close (savechanges = False)
Application.Quit
0
Ник Харди
1 / 1 / 0
Регистрация: 13.03.2010
Сообщений: 4
01.02.2012, 10:48  [ТС] 7
Закрывается, между прочим. Но спасибо, буду знать более эффективный способ!
0
01.02.2012, 10:48
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.02.2012, 10:48

Поиск открытой книги Excel Из Access
Помогите, пожалуйста, процедура, написанная Excele находит открытые книги, а в любом другом...

Копирование вкладки из одной открытой книги в другую
Есть две книги которым в коде назначены переменные, но если в первый раз копирование проходит, то...

VBA может узнать имя неактивной открытой книги и сделать её активной?
Привет! Столкнулся со следующей проблемой: Открыто две книги. Имя первой известно (она активная),...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.