Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выгрузка документации из архива - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выгрузка документации из архива (Макросы/Sub)
Выгрузка документации из архива
patravaevvlad Дата: Четверг, 14.12.2023, 13:34 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

2016
Есть макрос по выгрузки документации из архива со ссылками на конкретные ячейки

[vba]
Код
Sub Rar_UnRar()
Dim RetVal
Dim WinRarApp$, iFileName$, iArhivName$, adr$
filein = Range("D2")
folderOut = Range("D2")
WinRarApp$ = Chr(34) & "C:\Program Files\WinRAR\WinRAR.exe" & Chr(34) & " e " & " -o+ "
adr$ = WinRarApp$ & Chr(34) & filein & Chr(34) & " " & Chr(34) & folderOut & Chr(34)
RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
End Sub
[/vba]

Как сдлеать так чтобы он перебирал все заполненные ячейки в столбце C
 
Ответить
СообщениеЕсть макрос по выгрузки документации из архива со ссылками на конкретные ячейки

[vba]
Код
Sub Rar_UnRar()
Dim RetVal
Dim WinRarApp$, iFileName$, iArhivName$, adr$
filein = Range("D2")
folderOut = Range("D2")
WinRarApp$ = Chr(34) & "C:\Program Files\WinRAR\WinRAR.exe" & Chr(34) & " e " & " -o+ "
adr$ = WinRarApp$ & Chr(34) & filein & Chr(34) & " " & Chr(34) & folderOut & Chr(34)
RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
End Sub
[/vba]

Как сдлеать так чтобы он перебирал все заполненные ячейки в столбце C
Автор - patravaevvlad
Дата добавления - 14.12.2023 в 13:34
mgt Дата: Пятница, 15.12.2023, 09:03 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 98
Репутация: 25 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub Rar_UnRar()
Dim RetVal
Dim c As Range
Dim WinRarApp$, adr$
WinRarApp$ = Chr(34) & "C:\Program Files\WinRAR\WinRAR.exe" & Chr(34) & " e " & " -o+ "
For Each c In Range(Cells(UsedRange.Row, 3), Cells(UsedRange.Rows.Count, 3))
    If c <> "" Then
        adr$ = WinRarApp$ & Chr(34) & c & Chr(34) & " " & Chr(34) & c & Chr(34)
        RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
    End If
Next
End Sub
[/vba]


Сообщение отредактировал mgt - Пятница, 15.12.2023, 09:08
 
Ответить
Сообщение[vba]
Код
Sub Rar_UnRar()
Dim RetVal
Dim c As Range
Dim WinRarApp$, adr$
WinRarApp$ = Chr(34) & "C:\Program Files\WinRAR\WinRAR.exe" & Chr(34) & " e " & " -o+ "
For Each c In Range(Cells(UsedRange.Row, 3), Cells(UsedRange.Rows.Count, 3))
    If c <> "" Then
        adr$ = WinRarApp$ & Chr(34) & c & Chr(34) & " " & Chr(34) & c & Chr(34)
        RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
    End If
Next
End Sub
[/vba]
Автор - mgt
Дата добавления - 15.12.2023 в 09:03
patravaevvlad Дата: Пятница, 15.12.2023, 10:41 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

2016
mgt, вылет ошибку в строке For Each
 
Ответить
Сообщениеmgt, вылет ошибку в строке For Each
Автор - patravaevvlad
Дата добавления - 15.12.2023 в 10:41
mgt Дата: Пятница, 15.12.2023, 11:21 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 98
Репутация: 25 ±
Замечаний: 0% ±

Excel 2010
Документ свой покажите
 
Ответить
СообщениеДокумент свой покажите
Автор - mgt
Дата добавления - 15.12.2023 в 11:21
patravaevvlad Дата: Пятница, 15.12.2023, 11:47 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

2016
mgt, документацию берет из столбца C, а переносит в столбец D
К сообщению приложен файл: kniga1.xls (37.0 Kb)
 
Ответить
Сообщениеmgt, документацию берет из столбца C, а переносит в столбец D
Автор - patravaevvlad
Дата добавления - 15.12.2023 в 11:47
mgt Дата: Пятница, 15.12.2023, 13:07 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 98
Репутация: 25 ±
Замечаний: 0% ±

Excel 2010
del


Сообщение отредактировал mgt - Пятница, 15.12.2023, 13:23
 
Ответить
Сообщениеdel
Автор - mgt
Дата добавления - 15.12.2023 в 13:07
mgt Дата: Пятница, 15.12.2023, 13:18 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 98
Репутация: 25 ±
Замечаний: 0% ±

Excel 2010
С учетом того, что есть в вашем документе, логично делать так:
[vba]
Код
Sub Rar_UnRar1()
Dim RetVal
Dim WinRarApp$, adr$, i%
WinRarApp$ = Chr(34) & "C:\Program Files\WinRAR\WinRAR.exe" & Chr(34) & " e " & " -o+ "
For i = 2 To Range("c65536").End(xlUp).Row
    If Cells(i, 3).Value <> "" And Cells(i, 4).Value <> "" Then
        adr$ = WinRarApp$ & Chr(34) & Cells(i, 3).Value & Chr(34) & " " & Chr(34) & Cells(i, 4).Value & Chr(34)
        RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
    End If
Next i
End Sub
[/vba]
К сообщению приложен файл: 5878067.xlsm (13.8 Kb)


Сообщение отредактировал mgt - Пятница, 15.12.2023, 13:26
 
Ответить
СообщениеС учетом того, что есть в вашем документе, логично делать так:
[vba]
Код
Sub Rar_UnRar1()
Dim RetVal
Dim WinRarApp$, adr$, i%
WinRarApp$ = Chr(34) & "C:\Program Files\WinRAR\WinRAR.exe" & Chr(34) & " e " & " -o+ "
For i = 2 To Range("c65536").End(xlUp).Row
    If Cells(i, 3).Value <> "" And Cells(i, 4).Value <> "" Then
        adr$ = WinRarApp$ & Chr(34) & Cells(i, 3).Value & Chr(34) & " " & Chr(34) & Cells(i, 4).Value & Chr(34)
        RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
    End If
Next i
End Sub
[/vba]
Автор - mgt
Дата добавления - 15.12.2023 в 13:18
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выгрузка документации из архива (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!