Страницы: 1
RSS
Код для поиска файла по альтернативному пути., Как заставить код искать файл label.xlsx по альтернативному пути ?
 
Код
Selection.Copy
ChDir "C:\Users\Oleg\Desktop"
Workbooks.Open Filename:="label.xlsx"

Range("D2").Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats


ActiveWorkbook.Save

ActiveWorkbook.Close


Нужно чтобы работало на разных компьютерах, а там разные имена пользователей. А файл должен быть именно на рабочем столе.
В идеале файл должен искаться в ChDir "C:\Users\Oleg\Desktop", если его там нету,
то в ChDir "C:\Users\Igor\Desktop" а если и там нету , то сообщение MessageBox об отсутствии
 
cliff99,
поможет ↓
Код
Application.UserName
 
Добрый день. Вот путь к рабочему столу любого ПК:
Все работает, слеш кто будет добавлять вместо вас? Мы только подсказываем, а все остальное за вами.
Код
Environ("USERPROFILE") & "\Desktop"
'или более заморочено
Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop"

Sub b()
    Dim FilePath As String
    Selection.Copy
    'ChDir "C:\Users\Oleg\Desktop"
    'FilePath = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop\"
    'èëè
    FilePath = Environ("USERPROFILE") & "\Desktop\"
    Workbooks.Open Filename:=FilePath & "Òåñòò.xlsx" 'label
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub 
Изменено: DANIKOLA - 26.08.2020 11:58:31
 
Цитата
cliff99 написал:
Нужно чтобы работало...
Не с того начали. И Вам здравствуйте!
 
DANIKOLA, не работает.
Пишет, что не удалось найти файл.

я так понял поменять
'ChDir "C:\Users\Oleg\Desktop

на
Environ ("USERPROFILE") & "\Desktop"
Изменено: cliff99 - 26.08.2020 11:55:59
 
DANIKOLA,
теперь ясно что и эту строку нужно менять
'Workbooks.Open Filename:="label.xlsx"
на
Workbooks.Open Filename:=FilePath & "label.xlsx"
Код
Application.ScreenUpdating = False
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("C3").Select
FilePath = Environ("USERPROFILE") & "\Desktop\"
Workbooks.Open Filename:=FilePath & "label.xlsx"
    Range("A2:AL19999").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.ClearContents
    Range("S6").Select
ActiveWorkbook.Save
ActiveWorkbook.Close


В таком виде все работает.
Изменено: cliff99 - 26.08.2020 12:08:25
Страницы: 1
Наверх