Макрос excel имя книги

 

Inter_E

Пользователь

Сообщений: 399
Регистрация: 01.01.1970

Добрый день!  
Как можно Получить имя активной книги без его расширения (без ‘.xls’ or ‘xlsx’).    
Например АктивВоркбук.нэйм извлекает так «Книга.хлс» а нужно чтоб давало «Книга» и все.  
Спасибо заранее…

With my best regards,      Inter_E

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Привет.  
Public Sub qwe()  
Dim a As String, b As String  
b = ActiveWorkbook.Name  
a = Replace(b, «.xlsx», «»)  
If Len(a) = Len(b) Then a = Replace(b, «.xls», «»)  
End Sub

Я сам — дурнее всякого примера! …

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

А если в середине названия такое встречается? У меня бывало :)  
Может лучше анализировать 4-5 последних символов и отрезать. Да и ещё регистр символов может быть разный…

 

Inter_E

Пользователь

Сообщений: 399
Регистрация: 01.01.1970

{quote}{login=KuklP}{date=17.08.2010 01:28}{thema=}{post}Привет.  
Public Sub qwe()  
Dim a As String, b As String  
b = ActiveWorkbook.Name  
a = Replace(b, «.xlsx», «»)  
If Len(a) = Len(b) Then a = Replace(b, «.xls», «»)  
End Sub{/post}{/quote}  

  Да Hugo прав, если в середине окажется? Мне тоже мысль отрезать в первую очередь приходило. Но это тоже не красивый вариант.    
Может все таки есть такой нормальная-официальная функция?

With my best regards,      Inter_E

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Ну если в середине названия оказывается «.xls», то можно только посочувствовать тому, кто так называет файлы и помянуть добрым словом старый добрый DOS:-)  
Так, что берите.

Я сам — дурнее всякого примера! …

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

{quote}{login=Inter_E ответ > KuklP}{date=17.08.2010 01:41}{thema=Re: }{post}{quote}{login=KuklP}{date=17.08.2010 01:28}{thema=}{post}{/post}{/quote}если в середине окажется? {/post}{/quote}  
Inter_E, да кому же такое в голову (не больную) придёт?! Согласен с Сергеем.

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

Вдогонку: файл называется xls.Книга1

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

{quote}{login=Юрий М}{date=17.08.2010 02:20}{thema=}{post}Вдогонку: файл называется xls.Книга1{/post}{/quote} Не катит — точка не там. Надо:  .xls.Книга1:-)

Я сам — дурнее всякого примера! …

 

Inter_E

Пользователь

Сообщений: 399
Регистрация: 01.01.1970

Кажется всетаки есть какая-та функция вроде «ActiveWorkbook.RootName» для получения только имени…  
Неужели, это конец vb?  
Может попросим великих знатоков еще?

With my best regards,      Inter_E

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

MsgBox Replace(Application.Caption, «Microsoft Excel -«, «»)  
MsgBox Split(Application.Caption, «-«)(1)

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

{quote}{login=Юрий М}{date=17.08.2010 03:07}{thema=}{post}MsgBox Replace(Application.Caption, «Microsoft Excel -«, «»)  
MsgBox Split(Application.Caption, «-«)(1){/post}{/quote}  
И что получится?

Я сам — дурнее всякого примера! …

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Так, наверное:  
MsgBox Split(Replace(Application.Caption, «Microsoft Excel -«, «»), «.»)(0)

Я сам — дурнее всякого примера! …

 

Inter_E

Пользователь

Сообщений: 399
Регистрация: 01.01.1970

{quote}{login=KuklP}{date=17.08.2010 03:24}{thema=}{post}Так, наверное:  
MsgBox Split(Replace(Application.Caption, «Microsoft Excel -«, «»), «.»)(0){/post}{/quote}  

  Огромное спасибо Вам Юрий, KukIP!  
Теперь вроде правильно работает,даже если там внутри присутствуют слова xls, xlsx!

With my best regards,      Inter_E

 

Inter_E

Пользователь

Сообщений: 399
Регистрация: 01.01.1970

{quote}{login=Inter_E ответ > KuklP}{date=17.08.2010 03:32}{thema=Re: }{post}{quote}{login=KuklP}{date=17.08.2010 03:24}{thema=}{post}Так, наверное:  
MsgBox Split(Replace(Application.Caption, «Microsoft Excel -«, «»), «.»)(0){/post}{/quote}  

  Огромное спасибо Вам Юрий, KukIP!  
Теперь вроде правильно работает,даже если там внутри присутствуют слова xls, xlsx!{/post}{/quote}  

  Я думаю кто то точно сталкнется с этой проблемой  
и она теперь решена  
а так искал вроде до этого не было на форуме подобной проблемы!

With my best regards,      Inter_E

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Ну, так проще — меньше бубнов:  
MsgBox Split(ThisWorkbook.Name, «.»)(0)

Я сам — дурнее всякого примера! …

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

Тоже не универсально — ведь у человека может вдруг быть код  

  Private Sub Workbook_Open()  
   Application.Caption = » »  
   ActiveWindow.Caption = «Терпеть не могу — » & ThisWorkbook.Name  
End Sub  

  ну мало ли, терпеть не может Microsoft :)

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Но опять же, куча точек в названии не редкость. Вот, например с этого форума: CompareFiles.Find.Rus.v132.xls. Так, что вернулись на исходную.

Я сам — дурнее всякого примера! …

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

Пока писал, Сергей нашёл вариант, обходящий «Терпеть не могу» :)

 

webley

Пользователь

Сообщений: 1995
Регистрация: 01.01.1970

еще вариант:  
Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, «.») — 1)

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

Хм… у меня часто в названии точка используется вместо «_» …

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Вот для придурошных имен:  
Sub Макрос1()  
‘ Макрос записан 17.08.2010 (Sergey)  
Dim a As String, v  
a = ThisWorkbook.Name  
v = Split(a, «.»)  
MsgBox Replace(a, «.» & v(UBound(v)), «»)  
End Sub

Я сам — дурнее всякого примера! …

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

У webley короче.

Я сам — дурнее всякого примера! …

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

Да и с именем Bwdwqd.xls.jkkl.ook2.xls справился только webley.

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

{quote}{login=KuklP}{date=17.08.2010 03:18}{thema=Re: }{post}{quote}{login=Юрий М}{date=17.08.2010 03:07}{thema=}{post}{/post}{/quote}И что получится?{/post}{/quote}  
Нормально получится. Что не так?

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

то HUGO: Ну да.  
Юр, а у меня вместе с расширением заголовок. И МСГБОКС выдает его с расширением.

Я сам — дурнее всякого примера! …

 

А у меня вариант Юрия работает отлично, вот!  

  «39039»

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Так:

Я сам — дурнее всякого примера! …

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

Я же отталкивался от того, что вижу у себя :-)

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#30

17.08.2010 16:17:17

Серж, ремонтируй свой MsgBox :-)

прописать в макросе название книги с ячейки

Imba_Ra

Дата: Воскресенье, 02.12.2012, 13:05 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

Здравствуйте!
Очень нуждаюсь в Вашей помощи!
Есть макрос, он работает, но нужно его немного подправить.
Чтобы можно было:
1) копировать данные из закрытой книги (мой только при открытой копирует)
2) убрать расширение чтобы он не привязывался к определенному расширению книги. (т.е хотелось бы если просто если указываешь имя файла, такое как есть в ячейки)

[vba]

Code

Sub импорт()
On Error Resume Next
Set c = Workbooks(Cells(1, 2) & «.xlsx»).Worksheets(«Лист1»).Range(«A1:K20»).Find(«Товар», LookIn:=xlValues) ‘ тут бы хотелось убрать расширение т.е эту строчку & «.xlsx», т.к файлы бывают различного расширения
If Not c Is Nothing Then
Application.Goto c, True
Workbooks(«Книга2.xlsm»).Worksheets(«Отчет»).Cells(4, 2) = Cells(ActiveCell.Row, ActiveCell.Column + 1)
End If
Windows(«Книга2.xlsm»).Activate
End Sub

[/vba]

Сообщение отредактировал PelenaВоскресенье, 02.12.2012, 13:15

 

Ответить

ABC

Дата: Воскресенье, 02.12.2012, 14:46 |
Сообщение № 2

Группа: Друзья

Ранг: Обитатель

Сообщений: 397


Репутация:

112

±

Замечаний:
0% ±


Excel 2007

smile автор файла Ерик…???

[vba]

Code

Sub импорт()
     Dim wb As Workbook
     Application.ScreenUpdating = 0
     Set wb = GetObject(Cells(2, 2).Value & «» & Cells(1, 2).Value & «.xls»)
     Set c = wb.Worksheets(«Лист1»).Range(«A1:K20»).Find(«Товар», LookIn:=xlValues)    ‘Диапазон ячеек ГДЕ ищем
     If Err <> 0 Then MsgBox «Не указано имя файла или он не открыт»    ‘любая ошибка
     If Not c Is Nothing Then
         Application.Goto c, True
         ThisWorkbook.Worksheets(«Отчет»).Cells(4, 2).Value = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value    ‘Row +  — адрес от критерия
     End If
     ThisWorkbook.Activate
     wb.Close
     Application.ScreenUpdating = 1
End Sub

[/vba]


MS Excel 2007 and 2010…
——————————-
С Уважением, Даулет

 

Ответить

Imba_Ra

Дата: Воскресенье, 02.12.2012, 17:54 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

Quote (ABC)

smile автор файла Ерик…???

Да) smile
Спс большое за решение!

Quote (ABC)

Value & «.xls»)

А как можно сделать так чтобы не привязываться к определенному расширению ? т.к бывают файлы с разным расширением (.xls или .xlsx или .xlsm)

Quote (Imba_Ra)

On Error Resume Next

А почему эту строчку убрали? без нее выходит Debug если что то не указали, а это пугает сотрудников))
Её ведь можно указать в начале? или это не правильно?

 

Ответить

Imba_Ra

Дата: Воскресенье, 02.12.2012, 17:59 |
Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

ABC, Кстати Даулет мы ведь с одного города!)

 

Ответить

ABC

Дата: Воскресенье, 02.12.2012, 18:47 |
Сообщение № 5

Группа: Друзья

Ранг: Обитатель

Сообщений: 397


Репутация:

112

±

Замечаний:
0% ±


Excel 2007


MS Excel 2007 and 2010…
——————————-
С Уважением, Даулет

Сообщение отредактировал ABCВоскресенье, 02.12.2012, 20:12

 

Ответить

Imba_Ra

Дата: Воскресенье, 02.12.2012, 19:41 |
Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

ABC, Супер! то что нужно!
И последний вопрос. т.к значений копировать таким макросом нужно достаточное большое количество, подскажите как мне быть?
Например нужно еще скопировать еще сумму и срок. (Книга1)
Сам пытался разобраться, но не выходит…

 

Ответить

ABC

Дата: Воскресенье, 02.12.2012, 20:06 |
Сообщение № 7

Группа: Друзья

Ранг: Обитатель

Сообщений: 397


Репутация:

112

±

Замечаний:
0% ±


Excel 2007

если порядок как в первом файле
тогда поменяйте
.Cells(4, 2).Value = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
на
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row + 3, ActiveCell.Column + 1)).Copy _
Destination:=.Cells(4, 2)
ud отредактируйте

[vba]

Code

Sub ud()
        With ThisWorkbook.Worksheets(«Отчет»)
            .Range(«B1:B2»).Value = «»
            .Range(«B4:B6»).Value = «»
        End With
End Sub

[/vba]

5-ом посте добавил комент


MS Excel 2007 and 2010…
——————————-
С Уважением, Даулет

Сообщение отредактировал ABCВоскресенье, 02.12.2012, 20:14

 

Ответить

Imba_Ra

Дата: Вторник, 04.12.2012, 21:19 |
Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

В общем получилось следующее с помощью ABC,
Этот макрос использовал в начале

Этот для копировании остальных значений

Этим запускал все макросы

[vba]

Code

Sub Click
Call get1
Call get2
End Sub

[/vba]

В конце в последнем макросе добавил строчку, чтобы закрыть книгу откуда копировал т.к в начале в первом макросе ее открыли
‘wb.Close 0

Есть один вопрос, как можно при копировании вставлять значения? (бывают значения в виде формул и при копировании копируются эти формулы)

Сообщение отредактировал Imba_RaВторник, 04.12.2012, 23:17

 

Ответить

RAN

Дата: Вторник, 04.12.2012, 21:36 |
Сообщение № 9

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Запишите рекордером специальная вставка — значения.
И спрячьте эту простыню в спойлер.


Быть или не быть, вот в чем загвоздка!

 

Ответить

ABC

Дата: Вторник, 04.12.2012, 21:49 |
Сообщение № 10

Группа: Друзья

Ранг: Обитатель

Сообщений: 397


Репутация:

112

±

Замечаний:
0% ±


Excel 2007

как Андрей написал
Cells(ActiveCell.Row, ActiveCell.Column + 12).Copy _
Destination:=.Cells(19, 3)

Cells(ActiveCell.Row, ActiveCell.Column + 1).Copy
.Cells(19, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


MS Excel 2007 and 2010…
——————————-
С Уважением, Даулет

Сообщение отредактировал ABCВторник, 04.12.2012, 21:59

 

Ответить

Imba_Ra

Дата: Вторник, 04.12.2012, 22:00 |
Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

ABC, Ок, спс!

RAN, сейчас научусь как это делать и исправлю

 

Ответить

Imba_Ra

Дата: Вторник, 04.12.2012, 22:55 |
Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

вроде освоил)

 

Ответить

Imba_Ra

Дата: Вторник, 04.12.2012, 22:56 |
Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

.

Сообщение отредактировал Imba_RaВторник, 04.12.2012, 23:04

 

Ответить

Dragokas

Дата: Среда, 05.12.2012, 01:35 |
Сообщение № 14

Группа: Проверенные

Ранг: Новичок

Сообщений: 14


Репутация:

25

±

Замечаний:
0% ±


2003

Один вопрос:
[vba]

Code

Application.Goto c, True

[/vba]
— это трюк, чтобы не использовать метод FindNext я так понимаю?

 

Ответить

Imba_Ra

Дата: Пятница, 07.12.2012, 20:16 |
Сообщение № 15

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

Quote (Imba_Ra)

FName = Cells(1, 2).Value & «.xlsx» ‘имя файла

Друзья подскажите как можно убрать расширение т.к сделать так чтобы можно было работать с любым расширением

Quote (Imba_Ra)

Sub get2()
Set c = Workbooks(Cells(4, 4) & «.xlsx»).Worksheets(«Резюме»).Range(«A6:AY20»).Find(«Программа кредитования:», LookIn:=xlValues) ‘Диапазон ячеек ГДЕ ищем
If Not c Is Nothing Then
Application.GoTo c, True
With ThisWorkbook.Worksheets(«Compare»)
Cells(ActiveCell.Row, ActiveCell.Column + 12).Copy _
Destination:=.Cells(19, 3) ‘копируем данные
End With
Else: ThisWorkbook.Worksheets(«Compare»).Range(«C19»).Value = «»
End If
ThisWorkbook.Activate
‘если где та вылетить ошибка, тогда очищаем данные с ячеек «C18»
GoTo Ends:
Errors1:
ThisWorkbook.Worksheets(«Compare»).Range(«C19»).Value = «»
Ends:
Application.ScreenUpdating = 1
End Sub

И как в конце закрыть активную книгу, которая была открыта в первом макросе скрыта

Quote (Imba_Ra)

Set wb = GetObject(FPath & «» & FName) ‘открываем скрыто

 

Ответить

Serge_007

Дата: Пятница, 07.12.2012, 20:18 |
Сообщение № 16

Группа: Админы

Ранг: Местный житель

Сообщений: 15894


Репутация:

2623

±

Замечаний:
±


Excel 2016

Quote (Imba_Ra)

как можно убрать расширение т.к сделать так чтобы можно было работать с любым расширением

В настройках Windows


ЮMoney:41001419691823 | WMR:126292472390

 

Ответить

Imba_Ra

Дата: Пятница, 07.12.2012, 20:29 |
Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 20

Quote (Serge_007)

В настройках Windows

т.е нужно у всех сотрудников настраивать Windows?
А можно это сделать в самом макросе?

 

Ответить

Serge_007

Дата: Пятница, 07.12.2012, 20:31 |
Сообщение № 18

Группа: Админы

Ранг: Местный житель

Сообщений: 15894


Репутация:

2623

±

Замечаний:
±


Excel 2016

Я таких способов не знаю


ЮMoney:41001419691823 | WMR:126292472390

 

Ответить

RAN

Дата: Пятница, 07.12.2012, 21:41 |
Сообщение № 19

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Quote (Imba_Ra)

А как можно сделать так чтобы не привязываться к определенному расширению ? т.к бывают файлы с разным расширением (.xls или .xlsx или .xlsm)

1.
[vba]

Code

FName = Cells(1, 2).Value & «.xls*»

[/vba]
2.
[vba]

Code

If FName like Cells(1, 2).Value  then

[/vba]


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RANПятница, 07.12.2012, 21:45

 

Ответить

Serge_007

Дата: Пятница, 07.12.2012, 21:44 |
Сообщение № 20

Группа: Админы

Ранг: Местный житель

Сообщений: 15894


Репутация:

2623

±

Замечаний:
±


Excel 2016

Андрей, так только экселевские файлы можно (да и то не все),

Quote (Imba_Ra)

сделать так чтобы можно было работать с любым расширением

не получится


ЮMoney:41001419691823 | WMR:126292472390

 

Ответить

Check if your variable Filename contains the correct filename. (e.g. Sample.xls)
Also check if input_path_1 and input_file_1 have correct values.
If they have it should be like this:

Workbooks(Filename).Activate

Now, if you need to append the extension name (e.g. Filename value is just Sample):

Workbooks(Filename & ".xls").Activate

The argument should always be in the form of string and should be the complete filename (with extension). Although numerals (index) is also accepted, you can’t be sure what index refer to what workbook. Better yet, assign it to a variable.

Dim otherWB As Workbook
Set otherWB = Workbooks(Filename)
'Set otherWB = Workbooks(Filename & ".xls") '~~> for second scenario above

Edit1: From comment, if Filename contains the fullpath, then this might work.

Dim Filename1 As String
Filename1 = Split(Filename, "")(UBound(Split(Filename, "")))
Workbooks(Filename1).Activate

Как определить имя Книги, в которой запускается Макрос?

qwertyhp
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя

 
Сообщения: 156
Зарегистрирован: 07.10.2009 (Ср) 15:02
Откуда: Москва

Как определить имя Книги, в которой запускается Макрос?

Здравствуйте!
Подскажите — как определить имя/путь Книги Excel, в которой находится запускаемый макрос, если этот макрос запускается из окна другой книги Excel?
Спасибо.

Пятачок Forever! :)


Template
Обычный пользователь
Обычный пользователь
 
Сообщения: 73
Зарегистрирован: 09.09.2006 (Сб) 18:03

Re: Как определить имя Книги, в которой запускается Макрос?

Сообщение Template » 21.05.2013 (Вт) 21:37

Ежели это требуется определить во время выполнения макроса, то ThisWorkbook

Код: Выделить всё
ThisWorkbook.Name
ThisWorkbook.FileName
ThisWorkbook.FullName


qwertyhp
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя

 
Сообщения: 156
Зарегистрирован: 07.10.2009 (Ср) 15:02
Откуда: Москва

Re: Как определить имя Книги, в которой запускается Макрос?

Сообщение qwertyhp » 22.05.2013 (Ср) 13:10

To Template:
Огромное спасибо! ThisWorkbook.FileName не прокатило, но ThisWorkbook.Name и ThisWorkbook.FullName полностью решили проблему. Еще раз спасибо!

Пятачок Forever! :)



Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

Студворк — интернет-сервис помощи студентам

Добрый день уважаемые программисты !
В программировании я ни бум-бум, поэтому прошу у Вас помощи.

Нужен простой макрос который будет переименовывать имя книги при закрытии, по имени ячейки (например меняем текст в ячейке A1 на «Договор №1», получаем книгу с именем «Договор №1»).
Когда-то очень давно мне попадался такой макрос на просторах инета, но сейчас уже все перегуглил, найти не могу! ((
Заранее всем спасибо!

Добавлено через 3 минуты
Вот кое что нашел, но этот макрос работает по открытию книги ((. А мне нужно что бы имя книги менялось сразу по закрытию. Может кто знает что поменять нужно ?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Workbook_Open()
sv = Sheets("Лист1").Cells(1, 1)
' Имя листа с ячейкой А1
If Len(sv) = 0 Then Exit Sub
sv = sv & ".xls"
s = ThisWorkbook.Name
If s <> sv Then
s1 = ThisWorkbook.FullName
s2 = ThisWorkbook.Path
s2 = s2 & "/" & sv
ThisWorkbook.SaveAs Filename:=s2
Kill s1
End If
End Sub

Открытие книги Excel из кода VBA. Проверка существования книги. Создание новой книги, обращение к открытой книге и ее закрытие. Методы Open, Add и Close.

Открытие существующей книги

Существующая книга открывается из кода VBA Excel с помощью метода Open:

Workbooks.Open Filename:=«D:test1.xls»

или

Workbooks.Open («D:test1.xls»)

В кавычках указывается полный путь к открываемому файлу Excel. Если такой файл не существует, произойдет ошибка.

Проверка существования файла

Проверить существование файла можно с помощью функции Dir. Проверка существования книги Excel:

If Dir(«D:test1.xls») = «» Then

    MsgBox «Файл не существует»

Else

    MsgBox «Файл существует»

End If

Или, если файл (книга Excel) существует, можно сразу его открыть:

If Dir(«D:test1.xls») = «» Then

    MsgBox «Файл не существует»

Else

    Workbooks.Open Filename:=«D:test1.xls»

End If

Создание новой книги

Новая рабочая книга Excel создается в VBA с помощью метода Add:

Созданную книгу, если она не будет использоваться как временная, лучше сразу сохранить:

Workbooks.Add

ActiveWorkbook.SaveAs Filename:=«D:test2.xls»

В кавычках указывается полный путь сохраняемого файла Excel, включая присваиваемое имя, в примере — это «test2.xls».

Обращение к открытой книге

Обращение к активной книге:

Обращение к книге с выполняемым кодом:

Обращение к книге по имени:

Workbooks(«test1.xls»)

Workbooks(«test2.xls»)

Обратиться по имени можно только к уже открытой книге, а чтобы из кода VBA Excel книгу открыть, необходимо указать полный путь к файлу.

Открытая рабочая книга закрывается из кода VBA Excel с помощью метода Close:

Workbooks(«test1.xlsx»).Close

Если закрываемая книга редактировалась, а внесенные изменения не были сохранены, тогда при ее закрытии Excel отобразит диалоговое окно с вопросом: Вы хотите сохранить изменения в файле test1.xlsx? Чтобы файл был закрыт без сохранения изменений и вывода диалогового окна, можно воспользоваться параметром метода Close — SaveChanges:

Workbooks(«test1.xlsx»).Close  SaveChanges:=False

или

Workbooks(«test1.xlsx»).Close  (False)

Закрыть книгу Excel из кода VBA с сохранением внесенных изменений можно также с помощью параметра SaveChanges:

Workbooks(«test1.xlsx»).Close  SaveChanges:=True

или

Workbooks(«test1.xlsx»).Close (True)


Фразы для контекстного поиска: открыть книгу, открытие книги, создать книгу, создание книги, закрыть книгу, закрытие книги, открыть файл Excel, открытие файла Excel, существование книги, обратиться к открытой книге.


Доброго дня!

Обычно делаю так:

Перед открытием файла, запоминаю параметры исходного:

WBOld = Thisworkbook.Name
WSOld = ActiveSheet.Name

Теперь открываю нужный файл. Естественно, что он после открытия становится активным.
Ну а дальше варианты:
Если мне нужно из этого активного файла переписать данные в файл открывающий (например значение в ячейке E2, вызываемого файла, активный лист), то записываю данные в переменную (-нные) и затем:

  param=0
  param=cells(2,5).Value
  With workbooks(WBOld).Worksheets(WSOld)
     .cells(3,2)=param
     param=0
  End With

В случае, если же мне нужно перейти в вызывающую книгу и вызывающий лист, то так

workbooks(WBOld).activate
Worksheets(WSOld).select

Вот кусок кода:

'собираем перечень использованных в эти даты объектов = Start ===
    'запоминаем исходные книгу и лист
    wobk = ThisWorkbook.Name
    wost = "DayWork"

        'Открываем Tbl&CC.xls
    ''Проверяем не открыта ли она уже,
    fil01 = False
    For Each wbk In Workbooks
        If wbk.Name = "Tbl&CC.xls" Then
            fil01 = True
            Exit For
        End If
    Next
    'если не открыта, то открываем
    If fil01 = False Then
        Application.ScreenUpdating = False '- отключаем обновление экрана
        Application.EnableEvents = False '- отключаем реакцию на события

                Workbooks.Open Filename:="\EnergypoleTbl&CC.xls", ReadOnly:=True, Password:="Wolf" '- только на чтение

                Application.EnableEvents = True '- включаем реакцию на события
    End If

        With Workbooks("Tbl&CC.xls").Worksheets("CCS")
        'определяем занятую данными область листа == Start ==
        Set blok = .UsedRange
        nREnd = blok.Row + blok.Rows.Count - 2
        Set blok = Nothing
        'определяем занятую данными область листа == Stop ==
        If nREnd < 3 Then
            MsgBox "База Табеля [Tbl&CC.xls] - ПУСТА!", vbQuestion + vbOKOnly, ""

                        closeTabel fil01

                        Exit Sub
        End If

                'формируем массив объектов
        k = 0
        ReDim arrNabor(k)
        datT = 0

                i = 0
        For i = nREnd To 4 Step -1
            datT = .Cells(i, 6).Value
            flgT = False
'Stop
            j = 0
            For j = LBound(arrVibor) To UBound(arrVibor)
                If datT = CDate(arrVibor(j)) Then
                    flgT = True
                End If
            Next j

                        If flgT = True Then
'
                datR = .Cells(i, 2).Text
                flgQ = False
                f = 0
                For f = LBound(arrNabor) To UBound(arrNabor)
                    If datR = arrNabor(f) Then
                        flgQ = True
                    End If
                Next f

                            If flgQ = False Then
                    If k > 0 Then
                        ReDim Preserve arrNabor(k)
                    End If
                    arrNabor(k) = datR
                    k = k + 1
                End If
            End If
'
            datT = 0
            datR = ""
        Next i

            End With

        Erase arrVibor

        closeTabel fil01

    Workbooks(wobk).Worksheets(wost).Activate

    'собираем перечень использованных в эти даты объектов = Stop ===

если непонятно — спрашивайте …

Понравилась статья? Поделить с друзьями:
  • Макрос excel изменение цвета в ячейке
  • Макрос excel заполнение пустых ячеек
  • Макрос excel запись ячейки
  • Макрос excel для перехода на другой лист в excel
  • Макрос excel запись невозможна