Подставить значение текущего каталога - Microsoft Office Excel

kzld · 07.12.2009, 13:36

Как в макросе заменить значение
iPath = "C:\Temp\" выделено жирным
на значение текущего рабочего каталога

Sub SeparateTable()
Dim iLastRowBaza As Long
Dim iLastRowSht As Long
Dim NameOfGoods As String
Dim i As Long
Dim BazaSht As Worksheet
Dim iPath As String

Application.ScreenUpdating = False
Set BazaSht = ActiveSheet
iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row
If iLastRowBaza <= 2 Then
MsgBox "На листе нет данных", 48, "Ошибка"
Exit Sub
End If
iPath = "C:\Temp\"
If Dir(iPath) = "" Then
MsgBox "Каталога" & iPath & " не существует", 48, ""
Exit Sub
End If
Workbooks.Add
BazaSht.Range("A1:L2").Copy Destination:=Range("A1")
For i = 3 To iLastRowBaza
NameOfGoods = BazaSht.Cells(i, 1)
If i > 3 Then
If NameOfGoods <> BazaSht.Cells(i - 1, 1) Then
ActiveWorkbook.SaveAs Filename:=iPath & BazaSht.Cells(i - 1, 1)
ActiveWorkbook.Close
Workbooks.Add
BazaSht.Range("A1:L2").Copy Destination:=Range("A1")
End If
End If

VictorM · 07.12.2009, 13:41

iPath = ActiveWorkbook.Path

kzld · 07.12.2009, 14:04

Цитата:

Сообщение от VictorM

iPath = ActiveWorkbook.Path

Спасибо
Спасибо

kzld · 07.12.2009, 14:20

Цитата:

Сообщение от kzld

Спасибо
Спасибо

Пишет
Каталога не существует

The_Prist · 07.12.2009, 14:29

Присваивать значение пути таким методом -

Код:

iPath = ActiveWorkbook.Path

надо до этих строк

Код:

Workbooks.Add

Иначе да, пути не существует, т.к. вновь созданная книга еще нигде не сохранена и не имеет, так сказать, официального пути расположения.
А вообще, я сначала подумал, что нужен текущий каталог в прямом смысле слова.

Код:

Dim sCurPuth As String
sCurPuth = CurDir

kzld · 07.12.2009, 14:35

Цитата:

Сообщение от The_Prist

Присваивать значение пути таким методом -

Код:

iPath = ActiveWorkbook.Path

надо до этих строк

Код:

Workbooks.Add

Иначе да, пути не существует, т.к. вновь созданная книга еще нигде не сохранена и не имеет, так сказать, официального пути расположения.
А вообще, я сначала подумал, что нужен текущий каталог в прямом смысле слова.

Код:

Dim sCurPuth As String
sCurPuth = CurDir

В макросах не силён.
Если не составит труда, прошу переделать (исправить) приведённые выше листинг макроса

The_Prist · 07.12.2009, 14:42

Код:

Sub SeparateTable()
Dim iLastRowBaza As Long, iLastRowSht As Long,i As Long
Dim NameOfGoods As String,iPath As String
Dim BazaSht As Worksheet

Application.ScreenUpdating = False
Set BazaSht = ActiveSheet
iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row
If iLastRowBaza <= 2 Then
MsgBox "На листе нет данных", 48, "Ошибка"
Exit Sub
End If
iPath = ActiveWorkbook.Path
If Dir(iPath) = "" Then
MsgBox "Каталога" & iPath & " не существует", 48, ""
Exit Sub
End If
Workbooks.Add
BazaSht.Range("A1:L2").Copy Destination:=Range("A1")
For i = 3 To iLastRowBaza
NameOfGoods = BazaSht.Cells(i, 1)
If i > 3 Then
If NameOfGoods <> BazaSht.Cells(i - 1, 1) Then
ActiveWorkbook.SaveAs Filename:=iPath & BazaSht.Cells(i - 1, 1)
ActiveWorkbook.Close
Workbooks.Add
BazaSht.Range("A1:L2").Copy Destination:=Range("A1")
End If
End If

kzld · 07.12.2009, 14:55

Цитата:

Сообщение от The_Prist

[CODE]Sub SeparateTable()

Спасибо, буду пробовать

kzld · 07.12.2009, 15:14

Цитата:

Сообщение от The_Prist

Код:

Sub SeparateTable()
Dim iLastRowBaza As Long, iLastRowSht As Long,i As Long
Dim NameOfGoods As String,iPath As String
Dim BazaSht As Worksheet

Application.ScreenUpdating = False
Set BazaSht = ActiveSheet
iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row
If iLastRowBaza <= 2 Then
MsgBox "На листе нет данных", 48, "Ошибка"
Exit Sub
End If
iPath = ActiveWorkbook.Path
If Dir(iPath) = "" Then
MsgBox "Каталога" & iPath & " не существует", 48, ""Exit Sub
End If
Workbooks.Add
BazaSht.Range("A1:L2").Copy Destination:=Range("A1")
For i = 3 To iLastRowBaza
NameOfGoods = BazaSht.Cells(i, 1)
If i > 3 Then
If NameOfGoods <> BazaSht.Cells(i - 1, 1) Then
ActiveWorkbook.SaveAs Filename:=iPath & BazaSht.Cells(i - 1, 1)
ActiveWorkbook.Close
Workbooks.Add
BazaSht.Range("A1:L2").Copy Destination:=Range("A1")
End If
End If

При пошаговом выполнении F8, спотыкается на строчке
MsgBox "Каталога" & iPath & " не существует", 48,

The_Prist · 07.12.2009, 15:16

Что значит спотыкается? Учитесь описывать саму ошибку, а не слово "спотыкается".
Скорее всего надо эту строчку подкорректировать

Код:

If Dir(iPath) = "" Then

вот так

Код:

If Dir(iPath,vbdirectory) = "" Then

07.12.2009, 13:36	#1
kzld Форумчанин Регистрация: 24.01.2009 Сообщений: 625	Подставить значение текущего каталога Как в макросе заменить значение iPath = "C:\Temp\" выделено жирным на значение текущего рабочего каталога Sub SeparateTable() Dim iLastRowBaza As Long Dim iLastRowSht As Long Dim NameOfGoods As String Dim i As Long Dim BazaSht As Worksheet Dim iPath As String Application.ScreenUpdating = False Set BazaSht = ActiveSheet iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row If iLastRowBaza <= 2 Then MsgBox "На листе нет данных", 48, "Ошибка" Exit Sub End If iPath = "C:\Temp\" If Dir(iPath) = "" Then MsgBox "Каталога" & iPath & " не существует", 48, "" Exit Sub End If Workbooks.Add BazaSht.Range("A1:L2").Copy Destination:=Range("A1") For i = 3 To iLastRowBaza NameOfGoods = BazaSht.Cells(i, 1) If i > 3 Then If NameOfGoods <> BazaSht.Cells(i - 1, 1) Then ActiveWorkbook.SaveAs Filename:=iPath & BazaSht.Cells(i - 1, 1) ActiveWorkbook.Close Workbooks.Add BazaSht.Range("A1:L2").Copy Destination:=Range("A1") End If End If

07.12.2009, 13:41	#2
VictorM Старожил Регистрация: 15.05.2008 Сообщений: 2,058	iPath = ActiveWorkbook.Path "Дайте людям рыбы, и вы накормите их на весь день; научите их ловить рыбу - и вы накормите их на всю жизнь" "Большое спасибо" - Z261597841314, R208907249777, U447361470499

07.12.2009, 14:29	#5
The_Prist Участник клуба Регистрация: 17.07.2009 Сообщений: 1,088	Присваивать значение пути таким методом - Код: `iPath = ActiveWorkbook.Path` надо до этих строк Код: `Workbooks.Add` Иначе да, пути не существует, т.к. вновь созданная книга еще нигде не сохранена и не имеет, так сказать, официального пути расположения. А вообще, я сначала подумал, что нужен текущий каталог в прямом смысле слова. Код: `Dim sCurPuth As String sCurPuth = CurDir` WebMoney - R298726502453; Яндекс.Деньги - 41001332272872 www.excel-vba.ru

07.12.2009, 15:16	#10
The_Prist Участник клуба Регистрация: 17.07.2009 Сообщений: 1,088	Что значит спотыкается? Учитесь описывать саму ошибку, а не слово "спотыкается". Скорее всего надо эту строчку подкорректировать Код: `If Dir(iPath) = "" Then` вот так Код: `If Dir(iPath,vbdirectory) = "" Then` WebMoney - R298726502453; Яндекс.Деньги - 41001332272872 www.excel-vba.ru

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Определение текущего каталога	Mutagena	Помощь студентам	3	01.12.2009 19:55
Приложение которое выводит список файлов текущего каталога и при клике на любом из файлов откроет его.	LimanSSk	Общие вопросы Delphi	2	18.05.2009 16:03
Найти и подставить значение из другой таблицы	ElenaTro	Microsoft Office Excel	1	01.04.2009 13:01
Как вывести на экран имена файлов текущего каталога? (С++)	Darw1n	Помощь студентам	1	13.12.2008 11:10
Изменение текущего каталога	mr2	Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM	2	04.02.2008 21:13