Çözüldü Makro ile başka sayfadaki Makroyu çalıştırmak

[yunusemre16]

Merhaba, elimde şu şekilde bir makro var;

Sub Makro2()

Workbooks.Open("C:\Users\MelekEdrem\Desktop\EDREMİT\EDREMİT AKTARIM AGUSTOS.xlsm").Worksheets(ActiveSheet.Name).Activate

End Sub

Bu kod ile düğmeye bastığımda diğer exceli açıyor, sormak istediğim şu;
Diğer exceli açtığımda orda da bir başka düğme yani makro var, düğmeye bastığımda o makroyu çalıştırmak istiyorum. Bunu nasıl yapabilirim.

Diğer excelde ki makro da şu şekilde;

Sub adoRapor()
'veyselEMRE 07042019
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\BiletiniAl\Reports\*Kasa*Raporu*.xls"
        If .Show = -1 Then fileopen = .SelectedItems(1)
    End With

    If fileopen = "" Then Exit Sub
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & fileopen & _
             "';Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"

    strsql = "SELECT [kULLANICI Adı], IIF ([Bilet Tipi]='Öğrenci', [Fiyat], NULL), " & _
             "IIF ([Bilet Tipi]='Tam', [Fiyat], NULL) FROM [SHEET$5:1000] WHERE NOT [Bilet Tipi] IS NULL"

    Set rs = CreateObject("Adodb.RecordSet")
    rs.Open strsql, strCon

    lst = rs.getrows

    With CreateObject("Scripting.Dictionary")
        Dim w(1 To 1, 1 To 2)
        For i = LBound(lst, 2) To UBound(lst, 2)
            If lst(0, i) <> "" Then ky = lst(0, i)
            If Not .exists(ky) Then .Item(ky) = w
            y = .Item(ky)
            If lst(1, i) <> "" Then y(1, 1) = lst(1, i)
            If lst(2, i) <> "" Then y(1, 2) = lst(2, i)
            .Item(ky) = y
        Next i
        son = Cells(Rows.Count, 1).End(3).Row
        Range("B2:G" & son).ClearContents
        For i = 2 To son
            ky = Cells(i, 1).Value
            If .exists(ky) Then
                Cells(i, 2).Resize(, 2).Value = .Item(ky)
                .Remove ky
            End If
        Next i
        If .Count > 0 Then
            kys = .keys
            itm = .items
            [H2].Value = "Hatalı Kayıtlar"
            For i = LBound(kys) To UBound(kys)
                Cells(i + 4, "H").Value = kys(i)
                Cells(i + 4, "I").Resize(, 2).Value = itm(i)
            Next i
        End If
    End With
    
End Sub

Makoların kodlarını atma sebebim, ikinci attığım makro başka bir exceli seçip veri aktarımı yapmamı sağlıyor.

Yardımcı olursanız çok sevinirim

 

[Muzaffer Ali]

Merhaba.

Dosya açıksa aşağıdaki şekilde çalıştırabilirsiniz.

Sub test()
    Run "'EDREMİT AKTARIM AGUSTOS'!adoRapor"
End Sub

 

[Muzaffer Ali]

Şunu belirtmem lazım;
"adoRapor" makrosunda aşağıdaki gibi hücre başvuruları var, burada dosya adı ve sayfa adı belirtilmediği için aktif dosyanın aktif sayfasındaki hücrelere başvurur. Bilginiz olsun.

Cells(Rows.Count, 1).End(3).Row
Range("B2:G" & son).ClearContents

 

[yunusemre16]

Merhaba.

Dosya açıksa aşağıdaki şekilde çalıştırabilirsiniz.

Sub test()
    Run "'EDREMİT AKTARIM AGUSTOS'!adoRapor"
End Sub

Merhaba,

sizin verdiğiniz kodu bu şekilde ekledim.

Sub Makro2()

Workbooks.Open("C:\Users\MelekEdrem\Desktop\EDREMİT\EDREMİT AKTARIM AGUSTOS.xlsm").Worksheets(ActiveSheet.Name).Activate

Run "'C:\Users\MelekEdrem\Desktop\EDREMİT\EDREMİT AKTARIM AGUSTOS.xlsm'!adoRapor"


End Sub

ve sorunsuz bir şekilde çalıştı. Size çok teşekkür ederim ve birşeyi daha merak ediyorum. EDREMİT AKTARIM AGUSTOS.xlsm dosyasını hiç açmadan. Başka bir excelde !adoRapor makrosunu çalıştırabilirmiyim. Böyle birşey mümkün mü acaba. Tekrardan dönüş yaparsanız çok sevinirim. Sorunuma da yardımcı olduğunuz için çok teşekkür ederim.

 

[Muzaffer Ali]

Sadece
Run "'C:\Users\MelekEdrem\Desktop\EDREMİT\EDREMİT AKTARIM AGUSTOS.xlsm'!adoRapor"

kodu ile kapalı dosya açılır ve makro çalıştırılabilir. Dosya hiç açılmadan makro çalıştırılması mümkün değil diye biliyorum.

Makro çalıştıktan sonra dosyayı kapatmak için. Bir de "EDREMİT AKTARIM AGUSTOS" dosyasına kapatma makrosu yazarsınız.

Örneğin

sub Kapat
thisworkbook.close true
end sub

true dosyayı kaydedip kapatır.
false yazarsanız kaydetmeden kapatır.
hiç bişe yazmazsanız kayıt etmek isteyip istemediğinizi sorar.

kullanmak için de dosya açık olduğu için sadece adını yazmanız yeterli
Run "'EDREMİT AKTARIM AGUSTOS.xlsm'!Kapat"

 

[yunusemre16]

Yardımlarınız ve ilginiz için çok teşekkür ederim. Birşey daha öğrenmiş oldum sayenizde. Teşekkürler