Dosyaya makro ile makro koymak

[muratgunay48]

Arkadaşlar, sayın hocalarım, başlık tam mecalimi anlatamadıysa özür dilerim. Ben daha önce yardım almıştım. Sorum şu (aslında biraz da merak ediyorum). İş yerinin web sitesinden rapor indiriyorum. xlsx uzantısı ile iniyor. Ben başka dosya ile (Raporları biçimlendirme dosyası) makro kullanarak inen raporu biçimlendiriyorum.
Doğal olarak yine xlsx uzantılı kaydediyor.
Acaba biçimlendirme bittikten sonra xlsm olarak kaydetse (hadi bunu hallettim) ve sayfa kod yerine

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("F2:F1000")) Is Nothing Then
        Me.Cells(Target.Row, "F").Value = "Köşe Yazarı"
    End If
End Sub

Yazdırmak mümkün mü?
Teşekkür ederim.
Saygılarımla.

 

[muhasebeciyiz]

Anladığım
Rapor indiriliyor (xlsx)
Başka bir dosya ile makro çalıştırıp biçimlendiriyorsun
Sonuçta dosya xlsm olarak kaydediliyor
Ayrıca ilgili sayfaya Worksheet kodu eklemek istiyorsun

Sub KodEkle()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim codeStr As String

    Set wb = ThisWorkbook ' veya hedef workbook
    Set ws = wb.Sheets("Sheet1") ' hedef sayfa adı

    codeStr = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf & _
    "    If Not Intersect(Target, Me.Range(""F2:F1000"")) Is Nothing Then" & vbCrLf & _
    "        Me.Cells(Target.Row, ""F"").Value = ""Köşe Yazarı""" & vbCrLf & _
    "    End If" & vbCrLf & _
    "End Sub"

    With wb.VBProject.VBComponents(ws.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, codeStr
    End With

End Sub

Makron şu sırayla ilerlesin:
XLSX dosyayı aç
Biçimlendirme işlemlerini yap
XLSM olarak kaydet
KodEkle prosedürünü çalıştır
Dosyayı kapat
Makro güvenliği açık olacak

 

[antonio]

Merhaba,
İnternetten indirdiğiniz dosyaları biçimlendirmek için kullandığınız dosyayı eklenti (".xlam" uzantılı) olarak kaydetmenizi, sonra da, bu eklentiyi dilediğiniz zaman etkinleştirerek kullanmanızı öneririm. (Excel'de eklenti etkinleştirme, devre dışı bırakma konusunu araştırınız).

 

[muratgunay48]

Anladığım
Rapor indiriliyor (xlsx)
Başka bir dosya ile makro çalıştırıp biçimlendiriyorsun
Sonuçta dosya xlsm olarak kaydediliyor
Ayrıca ilgili sayfaya Worksheet kodu eklemek istiyorsun

Sub KodEkle()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim codeStr As String

    Set wb = ThisWorkbook ' veya hedef workbook
    Set ws = wb.Sheets("Sheet1") ' hedef sayfa adı

    codeStr = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf & _
    "    If Not Intersect(Target, Me.Range(""F2:F1000"")) Is Nothing Then" & vbCrLf & _
    "        Me.Cells(Target.Row, ""F"").Value = ""Köşe Yazarı""" & vbCrLf & _
    "    End If" & vbCrLf & _
    "End Sub"

    With wb.VBProject.VBComponents(ws.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, codeStr
    End With

End Sub

Makron şu sırayla ilerlesin:
XLSX dosyayı aç
Biçimlendirme işlemlerini yap
XLSM olarak kaydet
KodEkle prosedürünü çalıştır
Dosyayı kapat
Makro güvenliği açık olacak

Aynen hocam. Başka dosya kullanarak düzenleme yapıyorum. Çünkü inen dosya standart değil. Onu, işte sütun sil, sütun satır ölçüsü en önemlisi de. F sütunu doluysa sağına bir kelime yazıyor. Ve kaydediyor. İşte o sütuna tıkladığım hücreler başka bir yazıya dönüşecek. Ama F kaçıncı sıra bilmiyoruz.
Çok teşekkür ederim hocam. Emeğinize sağlık.

 

[muratgunay48]

Merhaba,
İnternetten indirdiğiniz dosyaları biçimlendirmek için kullandığınız dosyayı eklenti (".xlam" uzantılı) olarak kaydetmenizi, sonra da, bu eklentiyi dilediğiniz zaman etkinleştirerek kullanmanızı öneririm. (Excel'de eklenti etkinleştirme, devre dışı bırakma konusunu araştırınız).

Bunu kullanmıştım hocam. Bazı makroları fonksiyona çevirerek. İşe yarıyor, teşekkür ederim.

 

[muratgunay48]

Anladığım
Rapor indiriliyor (xlsx)
Başka bir dosya ile makro çalıştırıp biçimlendiriyorsun
Sonuçta dosya xlsm olarak kaydediliyor
Ayrıca ilgili sayfaya Worksheet kodu eklemek istiyorsun

Sub KodEkle()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim codeStr As String

    Set wb = ThisWorkbook ' veya hedef workbook
    Set ws = wb.Sheets("Sheet1") ' hedef sayfa adı

    codeStr = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf & _
    "    If Not Intersect(Target, Me.Range(""F2:F1000"")) Is Nothing Then" & vbCrLf & _
    "        Me.Cells(Target.Row, ""F"").Value = ""Köşe Yazarı""" & vbCrLf & _
    "    End If" & vbCrLf & _
    "End Sub"

    With wb.VBProject.VBComponents(ws.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, codeStr
    End With

End Sub

Makron şu sırayla ilerlesin:
XLSX dosyayı aç
Biçimlendirme işlemlerini yap
XLSM olarak kaydet
KodEkle prosedürünü çalıştır
Dosyayı kapat
Makro güvenliği açık olacak

Hocam hedef dosyada hata verdi ama, yanlış mı yazdım acaba?

Sub deneme()

Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\Başka dosyaya makro atama\Test1.xlsx"
       
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          BİÇİMLENDİR          xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Son = Cells(Rows.Count, "A").End(3).Row
    For x = 1 To Son
    Cells(x, 2).Select
        If Cells(x, 1) <> "" Then
            ActiveCell.FormulaR1C1 = "Haber"
        End If
    Next x
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          KAYDET          xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

    ChDir Environ("USERPROFILE") & "\Desktop\Başka dosyaya makro atama"

    ActiveWorkbook.SaveAs Filename:= _
        Environ("USERPROFILE") & "\Desktop\Başka dosyaya makro atama\Test2.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          MAKRO ATA          xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim codeStr As String

    Set wb = Environ("USERPROFILE") & "\Desktop\Başka dosyaya makro atama\Test2.xlsm"
    Set ws = wb.Sheets("Sheet1") ' hedef sayfa adı

    codeStr = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf & _
    "    If Not Intersect(Target, Me.Range(""F2:F1000"")) Is Nothing Then" & vbCrLf & _
    "        Me.Cells(Target.Row, ""F"").Value = ""Köşe Yazarı""" & vbCrLf & _
    "    End If" & vbCrLf & _
    "End Sub"

    With wb.VBProject.VBComponents(ws.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, codeStr
    End With
 
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          KAPAT         xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
           
ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
Application.Visible = False

End Sub