Vba kod güncelleme talebi hakkında .

[mustilem23]

Elimde kullanmış olduğum bir makro var fakat pdf kayıt eder iken ismi 1 2 3 gibi kayıt ediyor kayıt ismini firma ismi olarak kaydettirmek istiyorum yada sabit bir yazı ile misal ba bs mutabakat gibi , yazılım güncelleme yapılabilir mi bu yönde teşekkürler.

End If
                    
                     yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & SMG.Cells(i, "z").Row  ".pdf"
                    
                    SD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    yol, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
                    
                   
                    
                    
                    
                    With Application
                        .EnableEvents = False
                        .ScreenUpdating = False
                    End With

makro tamamı .

Sub KOD()
    
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI
    On Error Resume Next
    Dim SD As Worksheet
    Dim SM As Worksheet
    Dim SMG As Worksheet
    Dim SR As Worksheet
    Set SD = Sheets("data")
    Set SM = Sheets("mizan")
    Set SMG = Sheets("mail gönder")
    Set SR = Sheets("rapor")
    
    If Selection.Column <> 3 Then Exit Sub
    With Selection
        ilk_sat = .Row
        son_sat = .Rows.Count + ilk_sat - 1
    End With
    
    For i = ilk_sat To son_sat
        
        If SMG.Cells(i, "C") <> "" Then
            
            For a = 2 To SM.Cells(Rows.Count, "B").End(3).Row
                
                If SMG.Cells(i, "C") = SM.Cells(a, "B") Then
                    
                    SD.Range("B19,B45") = SM.Cells(a, "B")
                   
                    
                    If SM.Cells(a, "H") = "" Then
                        SD.Range("G25") = "TL"
                    Else
                        SD.Range("g25") = SM.Cells(a, "H")
                    End If
                    
                    If SM.Cells(a, "F") > 0 Then
                        SD.Range("f25") = SM.Cells(a, "F")
                        SD.Range("h25") = "BORÇ/ALINACAK"
                    Else
                        SD.Range("F25") = SM.Cells(a, "G")
                        SD.Range("E26") = ""
                    End If
                    
                     yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & SMG.Cells(i, "z").Row & isim & ".pdf"
                    
                    SD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    yol, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
                    
                   
                    
                    
                    
                    With Application
                        .EnableEvents = False
                        .ScreenUpdating = False
                    End With
                    
                    Dim objOutlook As Object
                    Dim objMail As Object
                    Set objOutlook = CreateObject("Outlook.Application")
                    Set objMail = objOutlook.CreateItem(0)
                    With objMail
                        .To = SMG.Cells(i, "E").Value
                        .CC = " "
                        .Subject = SMG.Cells(i, "c").Value & " Bakiye ve cari mutabakat hakkında"
                        .Attachments.Add yol
                        .Save
                        .Display
                        '.Send
                    End With
                    
                    Kill yol
                    
                    sonsat = SR.Cells(Rows.Count, "A").End(3).Row + 1
                    SR.Cells(sonsat, "A") = SMG.Cells(i, "C")
                    SR.Cells(sonsat, "B") = SMG.Cells(i, "D")
                    SR.Cells(sonsat, "C") = Now
                    
                    Exit For
                    
                    Else: End If
                Next a
                
                
                Else: End If
            Next i
            
            Set objMail = Nothing
            Set objOutlook = Nothing
            
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
            
End Sub

 

[askm]

yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & SMG.Cells(i, "z").Row ".pdf"
satırındaki SMG.Cells(i, "z").Row alanındaki kısma çift tırnak içerisinde istediğiniz ifadeyi yazarak kaydedin. İsmi buradan alıyor.

 

[mustilem23]

Sayın askm .
Metin olarak birşey girdiğimde pdf oluşturulmuyor.
Başka sutun z yerine a yazdığımda yine bir değişme olmuyor.
Epey denme yaptıktan sonra konu açtım kontrol edebilme imkanınız mevcutmudur.

 

[Erkan Akayay]

yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & SMG.Cells(i, "z").Row ".pdf"

Row yerine Value yazın. O hücredeki değeri getirmek istiyorsunuz sanırım. Row ile değer değil Satır nosu yazdırıyorsunuz.

 

[mustilem23]

Çok teşekkür ederim sorunum çözüldü iyi akşamlar.