• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Masaüstü yol

muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,440
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Arkadaşlar, sayın hocalarım belki çok basit gelecek ama mutlaka bir yerde hata yapıyorum.
Bir dosyam var. İş yerindeki arkadaşlar da kullanacak.
RAPORLAR diye başladığı tamam.
Ancak herkesin "MASAÜSTÜ" yolu farklı. Mesela bende
ChDir "C:\Users\muratgunay48\Desktop\RAPORLAR\ALINAN RAPORLAR"
Bunu hiç uğraşmadan her masaüstüne yol olacak şekilde nasıl revize edebilirim?
Teşekkür ederim.
Saygılarımla.
 
Kod: 
Dim masaustu As String
Dim yol As String
masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"
ChDir yol

Bu kodu kim açarsa açsın:
kendi kullanıcı hesabının masaüstünü bulur
sonra RAPORLAR\ALINAN RAPORLAR klasörüne gider

daha kısa hali
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"

klasör yoksa hata vermesin dersen
Kod: 
Dim masaustu As String
Dim yol As String

masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"

If Dir(yol, vbDirectory) <> "" Then
    ChDir yol
Else
    MsgBox "Klasör bulunamadı: " & yol, vbExclamation
End If

senin örneğin birebir revize şöyle olur
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"
 
muhasebeciyiz' Alıntı:
Kod: 
Dim masaustu As String
Dim yol As String
masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"
ChDir yol

Bu kodu kim açarsa açsın:
kendi kullanıcı hesabının masaüstünü bulur
sonra RAPORLAR\ALINAN RAPORLAR klasörüne gider

daha kısa hali
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"

klasör yoksa hata vermesin dersen
Kod: 
Dim masaustu As String
Dim yol As String

masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"

If Dir(yol, vbDirectory) <> "" Then
    ChDir yol
Else
    MsgBox "Klasör bulunamadı: " & yol, vbExclamation
End If

senin örneğin birebir revize şöyle olur
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"
Genişletmek için tıkla ...


Hocam, öncelikle teşekkür ederim.
Tam olarak şöyle. Dosya açacak ve kayıt yapacak

Şu şekilde bitiyor

ChDir "C:\Users\muratgunay48\Desktop\RAPORLAR\ALINAN RAPORLAR"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\muratgunay48\Desktop\RAPORLAR\ALINAN RAPORLAR\DETAYLI RAPOR.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Bunun yerine

ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"
ActiveWorkbook.SaveAs Filename:= _
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR\DETAYLI RAPOR.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Şeklinde değiştirsek tamam mıdır?
 
Merhaba.
Alternatif olsun.

Kod: 
"C:\Users\muratgunay48\Desktop\RAPORLAR\ALINAN RAPORLAR"

Yukardaki adresin aynısını döndürür.
Kod: 
Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR "
 
Muzaffer Ali' Alıntı:
Merhaba.
Alternatif olsun.

Kod: 
"C:\Users\muratgunay48\Desktop\RAPORLAR\ALINAN RAPORLAR"

Yukardaki adresin aynısını döndürür.
Kod: 
Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR "
Genişletmek için tıkla ...

Hocam şöyle hata alıyorum.

Ekran görüntüsü 2026-03-06 163706.png

Hocam başına ChDir koymayı unutmuşum. Özür dilerim. Tekrar teşekkür ederim.
 
Son düzenleme:
Chdir kullanmadan isterseniz aşağıdaki gibi yapabilirsiniz.
Siz bir tane tırnak işareti fazladan koyduğunuz için hata veriyor
Kod: 
Sub DosyaAc_2()
    Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR\ÇEVRE TV.xlsx"
End Sub


Chdir kullanacaksanız aşağıdaki gibi yapabilirsiniz.
Kod: 
Sub DosyaAc_1()
    ChDir Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR"
    Workbooks.Open Filename:="ÇEVRE TV.xlsx"
End Sub

Not: Chdir varsayılan klasör adresini değiştirmek için kullanılır.
 
muhasebeciyiz' Alıntı:
Kod: 
Dim masaustu As String
Dim yol As String
masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"
ChDir yol

Bu kodu kim açarsa açsın:
kendi kullanıcı hesabının masaüstünü bulur
sonra RAPORLAR\ALINAN RAPORLAR klasörüne gider

daha kısa hali
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"

klasör yoksa hata vermesin dersen
Kod: 
Dim masaustu As String
Dim yol As String

masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"

If Dir(yol, vbDirectory) <> "" Then
    ChDir yol
Else
    MsgBox "Klasör bulunamadı: " & yol, vbExclamation
End If

senin örneğin birebir revize şöyle olur
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"
Genişletmek için tıkla ...

Hocam çok teşekkür ederim.
Muzaffer Ali' Alıntı:
Chdir kullanmadan isterseniz aşağıdaki gibi yapabilirsiniz.
Siz bir tane tırnak işareti fazladan koyduğunuz için hata veriyor
Kod: 
Sub DosyaAc_2()
    Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR\ÇEVRE TV.xlsx"
End Sub


Chdir kullanacaksanız aşağıdaki gibi yapabilirsiniz.
Kod: 
Sub DosyaAc_1()
    ChDir Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR"
    Workbooks.Open Filename:="ÇEVRE TV.xlsx"
End Sub

Not: Chdir varsayılan klasör adresini değiştirmek için kullanılır.
Genişletmek için tıkla ...

Bu daha pratik oldu hocam. Teşekkür ederim.
 
muhasebeciyiz' Alıntı:
Kod: 
Dim masaustu As String
Dim yol As String
masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"
ChDir yol

Bu kodu kim açarsa açsın:
kendi kullanıcı hesabının masaüstünü bulur
sonra RAPORLAR\ALINAN RAPORLAR klasörüne gider

daha kısa hali
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"

klasör yoksa hata vermesin dersen
Kod: 
Dim masaustu As String
Dim yol As String

masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\RAPORLAR\ALINAN RAPORLAR"

If Dir(yol, vbDirectory) <> "" Then
    ChDir yol
Else
    MsgBox "Klasör bulunamadı: " & yol, vbExclamation
End If

senin örneğin birebir revize şöyle olur
Kod: 
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAPORLAR\ALINAN RAPORLAR"
Genişletmek için tıkla ...
Hocam dosya direk masaüstünde ise şu şekilde nasıl revize edilir, doğru mudur?

Sub test4()
'Dosya yoksa hata vermesin

Dim masaustu As String
Dim yol As String

masaustu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
yol = masaustu & "\AAA"

If Dir(yol, vbDirectory) <> "" Then
ChDir yol

Workbooks.Open Filename:="TEST.xlsx"

Else
MsgBox "Klasör bulunamadı: " & yol, vbExclamation
End If

End Sub
 
Son düzenleme:
Bu kodu deneyiniz.

Kod: 
Sub test4()
    Dim Masaustu As String
    Dim Yol As String
    Dim Dosya As String
   
    Masaustu = Environ("USERPROFILE") & "\Desktop"
    Yol = Masaustu & "\AAA"
    Dosya = Yol & "\TEST.xlsx"
  
    If Dir(Yol, vbDirectory) <> "" Then
        ChDir Yol
        If Dir(Dosya) <> "" Then
            Workbooks.Open Filename:=Dosya
        Else
            MsgBox "Dosya bulunamadı: " & Dosya, vbExclamation
        End If
    Else
        MsgBox "Klasör bulunamadı: " & Yol, vbExclamation
    End If
End Sub
 
Muzaffer Ali' Alıntı:
Bu kodu deneyiniz.

Kod: 
Sub test4()
    Dim Masaustu As String
    Dim Yol As String
    Dim Dosya As String
  
    Masaustu = Environ("USERPROFILE") & "\Desktop"
    Yol = Masaustu & "\AAA"
    Dosya = Yol & "\TEST.xlsx"
 
    If Dir(Yol, vbDirectory) <> "" Then
        ChDir Yol
        If Dir(Dosya) <> "" Then
            Workbooks.Open Filename:=Dosya
        Else
            MsgBox "Dosya bulunamadı: " & Dosya, vbExclamation
        End If
    Else
        MsgBox "Klasör bulunamadı: " & Yol, vbExclamation
    End If
End Sub
Genişletmek için tıkla ...

Hocam teşekkür ederim. Emeğinize sağlık.
Hocam dosya üzerine yapacağımız işleri
Örneğin
Range("B13").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("C14:E18").Select

Workbooks.Open Filename:=Dosya

Altına yazmamız en doğrusu olacaktır değil mi?
 
Evet Workbooks.Open Filename:=Dosya satırının hemen altında olmalı

Select ile seçmek yerine direkt hücre adresini belirtmeniz yeterli
Örnek
Kod: 
With Range("B13").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
 
Muzaffer Ali' Alıntı:
Chdir kullanmadan isterseniz aşağıdaki gibi yapabilirsiniz.
Siz bir tane tırnak işareti fazladan koyduğunuz için hata veriyor
Kod: 
Sub DosyaAc_2()
    Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR\ÇEVRE TV.xlsx"
End Sub


Chdir kullanacaksanız aşağıdaki gibi yapabilirsiniz.
Kod: 
Sub DosyaAc_1()
    ChDir Environ("USERPROFILE") & "\Desktop\RAPORLAR\ALINAN RAPORLAR"
    Workbooks.Open Filename:="ÇEVRE TV.xlsx"
End Sub

Not: Chdir varsayılan klasör adresini değiştirmek için kullanılır.
Genişletmek için tıkla ...

Hocam çok özür dilerim tekrar rahatsız ediyorum ama ben bunu normal excel dosyalarına uyarladım. VBS dosyasına uyarlayamadım. Size zahmet bir baksanız.

Set WshNetwork = WScript.CreateObject("WScript.Network")

Set NewXL = CreateObject("Excel.Application")

Set MyWB = NewXL.workbooks.open("C:\Users\muratgunay48\Desktop\RAPORLAR\MAKRO.xlsm")
yerine
Set MyWB = NewXL.workbooks.open: =Environ("USERPROFILE") & "\Desktop\RAPORLAR\MAKRO.xlsm"
yazıyorum, hata veriyor

NewXL.Visible = True

NewXL.application.run "rapor"

MyWB.Close False

NewXL.Quit

Set MyWB = Nothing

Set NewXL = Nothing

Set WshNetwork = Nothing
 
Hata veren satırı aşağıdaki ile değiştirin.
Kod: 
Set MyWB = NewXL.Workbooks.Open(Filename:=Environ("USERPROFILE") & "\Desktop\RAPORLAR\MAKRO.xlsm")
 

Ekli dosyalar

  • Ekran görüntüsü 2026-03-10 152629.png
    Ekran görüntüsü 2026-03-10 152629.png
    13.6 KB · Görüntüleme: 3
Bu kodu deneyin.

Kod: 
Set WshNetwork = WScript.CreateObject("WScript.Network")

Set NewXL = CreateObject("Excel.Application")
Set MyWB = NewXL.Workbooks.Open(Environ("USERPROFILE") & "\Desktop\RAPORLAR\MAKRO.xlsm")

NewXL.Visible = True

NewXL.Application.Run "'" & MyWB.Name & "'!rapor"

MyWB.Close False
NewXL.Quit

Set MyWB = Nothing
Set NewXL = Nothing
Set WshNetwork = Nothing
 
Muzaffer Ali' Alıntı:
Bu kodu deneyin.

Kod: 
Set WshNetwork = WScript.CreateObject("WScript.Network")

Set NewXL = CreateObject("Excel.Application")
Set MyWB = NewXL.Workbooks.Open(Environ("USERPROFILE") & "\Desktop\RAPORLAR\MAKRO.xlsm")

NewXL.Visible = True

NewXL.Application.Run "'" & MyWB.Name & "'!rapor"

MyWB.Close False
NewXL.Quit

Set MyWB = Nothing
Set NewXL = Nothing
Set WshNetwork = Nothing
Genişletmek için tıkla ...
Hocam, sizi de uğraştırıyorum ama. Aynen yapıştırdım.
 

Ekli dosyalar

  • Ekran görüntüsü 2026-03-10 194747.png
    Ekran görüntüsü 2026-03-10 194747.png
    13.2 KB · Görüntüleme: 1
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst