Bazaprogram.ru

Новости из мира ПК
6 просмотров
Рейтинг статьи
1 звезда2 звезды3 звезды4 звезды5 звезд
Загрузка...

Vba excel путь к файлу

Microsoft Excel

трюки • приёмы • решения

Как в Excel отобразить полный путь файла книги

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

Переход к представлению Backstage

Один из способов увидеть путь активной книги — выбрать команду Файл ► Сведения. Путь активной книги отображается в верхней части представления Backstage.

Использование формулы

Другой вариант заключается в том, чтобы ввести следующую формулу в ячейку: =ЯЧЕЙКА(«имя_файла») . Формула показывает путь книги, в том числе имя листа, содержащего формулу.

Добавление элемента управления на панель быстрого доступа

Элемент управления под названием Размещение документа недоступен на ленте, но вы можете добавить его на свою панель быстрого доступа (рис. 177.1). К сожалению, вы не можете изменить ширину элемента, но если щелкнете на отображаемом имени, то увидите весь путь.

Рис. 177.1. Элемент управления Размещение документа, добавленный на панель быстрого доступа, позволяет увидеть полный путь активной рабочей книги

Чтобы добавить этот элемент управления на панель быстрого доступа, выполните следующие действия.

  1. Щелкните правой кнопкой мыши на панели быстрого доступа и выберите Настройка панели быстрого доступа.
  2. В разделе Панель быстрого доступа диалогового окна Параметры Excel в раскрывающемся списке слева выберите пункт Команды не на ленте.
  3. Прокрутите список вниз и выберите Размещение документа.
  4. Нажмите кнопку Добавить, чтобы добавить выбранный элемент управления на панель быстрого доступа.
  5. Нажмите кнопку ОК для закрытия окна Параметры Excel.

Отображение панели свойств документа

Еще один способ просмотреть путь активной книги — открыть панель Свойства документа. Выберите Файл ► Сведения ► Свойства ► Показать область сведений о документе. Панель отображается над строкой формул. К сожалению, она занимает много места и не может быть перемещена или уменьшена.

Вы, возможно, захотите добавить элемент управления Свойства на панель быстрого доступа. Делайте это так, как описано в предыдущем разделе, только в данном случае выберите раздел Файл в шаге 2 и команду Свойства в шаге 3. Элемент управления Свойства будет включать/выключать отображение панели свойств документа, так что вы можете просто щелкнуть на нем один раз, чтобы увидеть путь книги, а затем щелкнуть еще раз, чтобы скрыть панель.

Использование макросов

Если вас интересует использование VBA-макросов, введите следующую процедуру в модуль VBA:

Sub ShowPath() MsgBox ActiveWorkbook.Path End Sub

Добавьте макрос ShowPath на панель быстрого доступа. Когда эта процедура выполняется, путь активной книги отображается в окне сообщения.

Vba excel путь к файлу

Модератор форума: _Boroda_, Manyasha, SLAVICK, китин
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Путь к файлу переменными и сами переменные (Макросы/Sub)

Путь к файлу переменными и сами переменные

televnoyДата: Четверг, 15.03.2018, 21:21 | Сообщение № 1

Доброго времени суток уважаемые форумчане.
Задача состоит в том. Чтобы копировать файл в папку с новым именем, но с подменной данных из ячейки.
Нашел два макроса:
Первый копирует файл с новыми значениями

Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
Range(«C2:C65000»).Select
Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row — 1
Dim OLD_NAME(), NEW_NAME() As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
Range(«A1:B» + Trim(Str(sch_VERT + 1))).Sort Key1:=Range(«A2»), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))

Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + «»
Set FS = CreateObject(«Scripting.FileSystemObject»)
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + «OUT», vbDirectory) = «» Then
MkDir (Put_File + «OUT»)
End If
If Dir(Put_File + «OUT», vbDirectory) <> «» Then
‘If Len(Dir(Put_File + «OUT*.*»)) > 0 Then
‘Kill (Put_File + «OUT*.*»)
‘End If

For II = 1 To sch_VERT
For Each FILE In MASSIV
If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
FileCopy FILE, Application.ActiveWorkbook.Path + «OUT» + NEW_NAME(II, 1)
Cells(II + 1, 5).Value = «готов»
End If
Next
Next ‘ii
MsgBox «ГОТОВО»
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Второй изменяет текст

Хочу последний макрос вклинить в предыдущий, до последней процедуры.
Добавил переменные OLD_ & NEW_NAME, но как то я все криво понаделал.

Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
Range(«C2:C65000»).Select
Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row — 1
Dim OLD_NAME(), NEW_NAME(), OLD_ID(), NEW_ID As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
Range(«A1:B» + Trim(Str(sch_VERT + 1))).Sort Key1:=Range(«A2»), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))
‘_____________________________
OLD_ >NEW_ > ‘_____________________________
Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + «»
Set FS = CreateObject(«Scripting.FileSystemObject»)
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + «OUT», vbDirectory) = «» Then
MkDir (Put_File + «OUT»)
End If
If Dir(Put_File + «OUT», vbDirectory) <> «» Then
‘If Len(Dir(Put_File + «OUT*.*»)) > 0 Then
‘Kill (Put_File + «OUT*.*»)
‘End If
‘_____________________________
Const ForReading = 1
Const TristateFalse = 0
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Filename = Put_File + «OUT» & NEW_NAME
Set F = FSO.OpenTextFile(Filename, ForReading, TristateFalse)
WorkStrAll = F.ReadAll
WorkStrAll = Replace(WorkStrAll, OLD_ID, NEW_ID)
Set F = FSO.CreateTextFile(Filename, True)
F.Write (WorkStrAll)
F.Close
‘__________________________________

For II = 1 To sch_VERT
For Each FILE In MASSIV
If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
FileCopy FILE, Application.ActiveWorkbook.Path + «OUT» + NEW_NAME(II, 1)
Cells(II + 1, 5).Value = «готов»
End If
Next
Next ‘ii
MsgBox «ГОТОВО»
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Свои правки выделил ‘______________

Доброго времени суток уважаемые форумчане.
Задача состоит в том. Чтобы копировать файл в папку с новым именем, но с подменной данных из ячейки.
Нашел два макроса:
Первый копирует файл с новыми значениями

Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
Range(«C2:C65000»).Select
Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row — 1
Dim OLD_NAME(), NEW_NAME() As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
Range(«A1:B» + Trim(Str(sch_VERT + 1))).Sort Key1:=Range(«A2»), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))

Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + «»
Set FS = CreateObject(«Scripting.FileSystemObject»)
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + «OUT», vbDirectory) = «» Then
MkDir (Put_File + «OUT»)
End If
If Dir(Put_File + «OUT», vbDirectory) <> «» Then
‘If Len(Dir(Put_File + «OUT*.*»)) > 0 Then
‘Kill (Put_File + «OUT*.*»)
‘End If

For II = 1 To sch_VERT
For Each FILE In MASSIV
If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
FileCopy FILE, Application.ActiveWorkbook.Path + «OUT» + NEW_NAME(II, 1)
Cells(II + 1, 5).Value = «готов»
End If
Next
Next ‘ii
MsgBox «ГОТОВО»
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Второй изменяет текст

Хочу последний макрос вклинить в предыдущий, до последней процедуры.
Добавил переменные OLD_ & NEW_NAME, но как то я все криво понаделал.

Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
Range(«C2:C65000»).Select
Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row — 1
Dim OLD_NAME(), NEW_NAME(), OLD_ID(), NEW_ID As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
Range(«A1:B» + Trim(Str(sch_VERT + 1))).Sort Key1:=Range(«A2»), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))
‘_____________________________
OLD_ >NEW_ > ‘_____________________________
Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + «»
Set FS = CreateObject(«Scripting.FileSystemObject»)
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + «OUT», vbDirectory) = «» Then
MkDir (Put_File + «OUT»)
End If
If Dir(Put_File + «OUT», vbDirectory) <> «» Then
‘If Len(Dir(Put_File + «OUT*.*»)) > 0 Then
‘Kill (Put_File + «OUT*.*»)
‘End If
‘_____________________________
Const ForReading = 1
Const TristateFalse = 0
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Filename = Put_File + «OUT» & NEW_NAME
Set F = FSO.OpenTextFile(Filename, ForReading, TristateFalse)
WorkStrAll = F.ReadAll
WorkStrAll = Replace(WorkStrAll, OLD_ID, NEW_ID)
Set F = FSO.CreateTextFile(Filename, True)
F.Write (WorkStrAll)
F.Close
‘__________________________________

For II = 1 To sch_VERT
For Each FILE In MASSIV
If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
FileCopy FILE, Application.ActiveWorkbook.Path + «OUT» + NEW_NAME(II, 1)
Cells(II + 1, 5).Value = «готов»
End If
Next
Next ‘ii
MsgBox «ГОТОВО»
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Свои правки выделил ‘______________ televnoy

Сообщение Доброго времени суток уважаемые форумчане.
Задача состоит в том. Чтобы копировать файл в папку с новым именем, но с подменной данных из ячейки.
Нашел два макроса:
Первый копирует файл с новыми значениями

Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
Range(«C2:C65000»).Select
Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row — 1
Dim OLD_NAME(), NEW_NAME() As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
Range(«A1:B» + Trim(Str(sch_VERT + 1))).Sort Key1:=Range(«A2»), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))

Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + «»
Set FS = CreateObject(«Scripting.FileSystemObject»)
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + «OUT», vbDirectory) = «» Then
MkDir (Put_File + «OUT»)
End If
If Dir(Put_File + «OUT», vbDirectory) <> «» Then
‘If Len(Dir(Put_File + «OUT*.*»)) > 0 Then
‘Kill (Put_File + «OUT*.*»)
‘End If

For II = 1 To sch_VERT
For Each FILE In MASSIV
If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
FileCopy FILE, Application.ActiveWorkbook.Path + «OUT» + NEW_NAME(II, 1)
Cells(II + 1, 5).Value = «готов»
End If
Next
Next ‘ii
MsgBox «ГОТОВО»
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Второй изменяет текст

Хочу последний макрос вклинить в предыдущий, до последней процедуры.
Добавил переменные OLD_ & NEW_NAME, но как то я все криво понаделал.

Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
Range(«C2:C65000»).Select
Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row — 1
Dim OLD_NAME(), NEW_NAME(), OLD_ID(), NEW_ID As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
Range(«A1:B» + Trim(Str(sch_VERT + 1))).Sort Key1:=Range(«A2»), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))
‘_____________________________
OLD_ >NEW_ > ‘_____________________________
Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + «»
Set FS = CreateObject(«Scripting.FileSystemObject»)
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + «OUT», vbDirectory) = «» Then
MkDir (Put_File + «OUT»)
End If
If Dir(Put_File + «OUT», vbDirectory) <> «» Then
‘If Len(Dir(Put_File + «OUT*.*»)) > 0 Then
‘Kill (Put_File + «OUT*.*»)
‘End If
‘_____________________________
Const ForReading = 1
Const TristateFalse = 0
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Filename = Put_File + «OUT» & NEW_NAME
Set F = FSO.OpenTextFile(Filename, ForReading, TristateFalse)
WorkStrAll = F.ReadAll
WorkStrAll = Replace(WorkStrAll, OLD_ID, NEW_ID)
Set F = FSO.CreateTextFile(Filename, True)
F.Write (WorkStrAll)
F.Close
‘__________________________________

For II = 1 To sch_VERT
For Each FILE In MASSIV
If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
FileCopy FILE, Application.ActiveWorkbook.Path + «OUT» + NEW_NAME(II, 1)
Cells(II + 1, 5).Value = «готов»
End If
Next
Next ‘ii
MsgBox «ГОТОВО»
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Свои правки выделил ‘______________ Автор — televnoy
Дата добавления — 15.03.2018 в 21:21

Vba excel путь к файлу

1. Чтобы в поле имя файла уже автоматически занеслось заранее вычисленное в программе значение (это уже сделано, например имя будет в виде New[текущая дата].doc).
2. Чтобы автоматом меню «Сохранить как» предлагало сохранить файл в заранее известном каталоге.
Например есть структура каталогов D:MaxIXBTNew1 D:MaxIXBTNew2 и т .д.
Так вот нужно чтобы сразу открывался подкаталог «IXBT» а то в каком из каталогов New сохранять файл будет выбирать пользователь сам.

Заранее благодарен!

1. Akina , 30.05.2006 13:33
Смена каталога для вызова меню сохранения выполняется процедурой ChangeFileOpenDirectory перед вызовом стандартного диалога SaveAs.
2. fz-mix , 30.05.2006 13:38
Excel (XP):
Достаточно ознакомиться, желательно внимательно, с методом GetSaveAsFilename объекта Application.

Нижеследующее можно найти под F1.

цитата (MS Excel help):
GetSaveAsFilename Method

Displays the standard Save As dialog box and gets a file name from the user without actually saving any files.

expression.GetSaveAsFilename(InitialFilename, FileFilter, FilterIndex, Title, ButtonText)

expression Required. An expression that returns an Application object.

InitialFilename Optional Variant. Specifies the suggested file name. If this argument is omitted, Microsoft Excel uses the active workbook’s name.

FileFilter Optional Variant. A string specifying file filtering criteria.

This string consists of pairs of file filter strings followed by the MS-DOS wildcard file filter specification, with each part and each pair separated by commas. Each separate pair is listed in the Files of type drop-down list box. For example, the following string specifies two file filters, text and addin: «Text Files (*.txt), *.txt, Add-In Files (*.xla), *.xla».

To use multiple MS-DOS wildcard expressions for a single file filter type, separate the wildcard expressions with semicolons; for example, «Visual Basic Files (*.bas; *.txt),*.bas;*.txt».

If omitted, this argument defaults to «All Files (*.*),*.*».

FilterIndex Optional Variant. Specifies the index number of the default file filtering criteria, from 1 to the number of filters specified in FileFilter. If this argument is omitted or greater than the number of filters present, the first file filter is used.

Title Optional Variant. Specifies the title of the dialog box. If this argument is omitted, the default title is used.

ButtonText Optional Variant. Macintosh only.

Remarks
This method returns the selected file name or the name entered by the user. The returned name may include a path specification. Returns False if the user cancels the dialog box.

This method may change the current drive or folder.

Необходимый каталог и имя файла задается в первом параметре InitialFilename. Т.е. до вызова данного метода следует сгенерировать полный путь к файлу. В этом случае Excel при вызове метода отобразит каталог, указанный до имени файла, и предложит то имя файла, которое указано после пути.
Вот так все запутанно

3. V3 , 30.05.2006 13:42
SuperMaximus
1. Через FileSystemObject описание http://msdn.micrisoft.com/scripting
2. Через WinAPI
3. fileSaveName = Application.GetSaveAsFilename(«D:MaxIXBTNew1.xls»)

цитата: fz-mix:
Т.е. до вызова данного метода следует сгенерировать полный путь к файлу. В этом случае Excel при вызове метода отобразит каталог, указанный до имени файла, и предложит то имя файла, которое указано после пути.
Вот так все запутанно

Хм. так как я могу сгенерировать полный путь к файлу?

Он у меня создается и еще не сохранен на диске (могу сгенерировать максимум имя).
Куда его подставлять, этот сгенерированный полный путь к файлу?
Вот так?:

Sub SuperMaximus()
Dim Fs As String
Fs = Application.GetSaveAsFilename(InitialFileName:=»D:MaxIXBT», fileFilter:=»xls Files (*.xls), *.xls»)

‘вот тут должно появиться меню с уже заранее сгенерированным именем файла
‘в поле «Имя файла» меню «Сохранить как»
‘и открытым путем D:MaxIXBT, а я вручную выберу куда файл записать в New1
‘или в New2 и клацну «Сохранить»

Читать еще:  Красивые отчеты в excel
Ссылка на основную публикацию
Adblock
detector
4. SuperMaximus , 30.05.2006 14:56