Çözüldü Atlatmalı tarih yazdırma ve sayfayı resim olarak kaydetme işlemi

Katılım
14 Ekim 2021
Mesajlar
6
Excel Vers. ve Dili
Microsoft Office 2021 LTSC
Altın Üyelik Bitiş Tarihi
14-10-2023
244778

Kıymetli arkadaşlar üstadlar bir hatim listemiz var bu listeyi sürekli elle güncelliyoruz ben olmasam da yapacak biri yok dolayısıla işleri kolaylaştırmak için 4 farklı buton ekledim ekranda gördüğünüz

Sayfa Açıklaması:

YENİ HAFTA butonu her bir ismi bir aşağı kaydırıp en alttakinide en tepeye alıp haftalık güncelleme yapıyor ve bu kod çalışıyor.

TARİHİ YENİLE A33 hücresindeki metinde yer alan tarihi her bir tıklama ile bir hafta sonraya göndermesini istiyorum bunu bir türlü ayarlayamadım.

PDF KAYDET butonu aktif olarak çalışıyor.

RESİM KAYDET butonu çalışmıyor içine çalışan bir kod koyamadım araştırmama rağmen bulamadım acaba .PNG - .JPG formatında sayfayı kaydettirmek mümkün mü?


mor renkte olanlar benim sorularım yardımcı olursanız müteşekkir olurum.
 

Ekli dosyalar

bmutlu966

Altın Üye
Katılım
26 Ocak 2006
Mesajlar
756
Excel Vers. ve Dili
Office 365 İngilizce 64 Bit
Altın Üyelik Bitiş Tarihi
31-01-2025
Deneyiniz.
 

Ekli dosyalar

Katılım
14 Ekim 2021
Mesajlar
6
Excel Vers. ve Dili
Microsoft Office 2021 LTSC
Altın Üyelik Bitiş Tarihi
14-10-2023
Dosya birkaç günceleme ile harika bir hal aldı son ve ilave olarak yapmak istediğim şey

PDF kaydet ve Resim kaydet butonları her bilgisayara göre vb ye girip kodda değişiklik yapmak gerekiyor.
Bunun yerine "Yolu Al" diye bir buton yapıp dosyanın açıldığı oturumun kendi desktopu olacak şekilde otomatik hale getirmek istiyorum mümkün mü

ya da aynı işi butonsuz bir şekilde dosya her açıldığında otomatik olarak kendi yapsın.

Bu arada dosyanın son hali ekte
 

Ekli dosyalar

Son düzenleme:
Katılım
14 Ekim 2021
Mesajlar
6
Excel Vers. ve Dili
Microsoft Office 2021 LTSC
Altın Üyelik Bitiş Tarihi
14-10-2023
Dosya birkaç günceleme ile harika bir hal aldı son ve ilave olarak yapmak istediğim şey

PDF kaydet ve Resim kaydet butonları her bilgisayara göre vb ye girip kodda değişiklik yapmak gerekiyor.
Bunun yerine "Yolu Al" diye bir buton yapıp dosyanın açıldığı oturumun kendi desktopu olacak şekilde otomatik hale getirmek istiyorum mümkün mü

ya da aynı işi butonsuz bir şekilde dosya her açıldığında otomatik olarak kendi yapsın.

Bu arada dosyanın son hali ekte
Sorunu çözdüm:

aşağıdaki kodu
alt+f11 ile açılan vba editöründe "bu açlışma kitabı" bölümüne yapıştırdığım pdf kaydeden module2 ve jpeg kaydeden module 5 butonlarının kayıt kounumunu dosyanın açıldığı oturumun masaüstü olacak şekilde her açılıştı güncelliyor ve eğer orada daha önce bir adres varsa o adresi silip o anki oturumun masaüstü konumunu yeniden giriyor. Bu kodun çalışması için makro güvenliği- makro ayarları kısmından dijital imzalanmış makrolar dışındakileri devre dışı bırak seçili olmalı. sebebi de koddaki " Set vbComp = ThisWorkbook.VBProject.VBComponents(moduleName) " bu satır.

Kod:
Option Explicit

Private Sub Workbook_Open()
    Dim desktopPath As String
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

    ' Module2 güncelleme
    UpdateModuleCode "Module2", "savePath", desktopPath & "Hatim Çizelgesi"

    ' Module5 güncelleme
    Dim Resim As String
    Resim = "Hatim Çizelgesi" ' Resim değişkenini kendi adınıza göre güncelleyin
    UpdateModuleCode "Module5", "yol", desktopPath & "\" & Resim & ".jpeg"
End Sub

Private Sub UpdateModuleCode(moduleName As String, variableName As String, newValue As String)
    Dim vbComp As Object
    Dim codeMod As Object

    Set vbComp = ThisWorkbook.VBProject.VBComponents(moduleName)
    Set codeMod = vbComp.CodeModule

    Dim codeLines() As String
    codeLines = Split(codeMod.Lines(1, codeMod.CountOfLines), vbNewLine)

    Dim i As Long
    Dim foundLine As Boolean
    foundLine = False

    ' Değişkeni bul ve güncelle
    For i = LBound(codeLines) To UBound(codeLines)
        If InStr(1, codeLines(i), variableName & " = ") > 0 Then
            codeLines(i) = variableName & " = """ & newValue & """"
            foundLine = True
            Exit For
        End If
    Next i

    ' Kodu güncelle
    If foundLine Then
        codeMod.DeleteLines 1, codeMod.CountOfLines
        codeMod.AddFromString Join(codeLines, vbNewLine)
    End If
End Sub

Bu arada dosyayı final versiyonuyla paylaşıyorum ki istifade etmek isteyen arkadaşlar zahmet çekmesin.
 

Ekli dosyalar

Son düzenleme:
Üst