• Merhaba Dostlar,
    yeni forum ile yola devam ediyoruz. Bu büyüklükte bir forum yeni bir sisteme taşımak epey bir yordu bizi. Üstelik bir de yeni XenForo Forum altyapısına geçtik.
    Eminim çok yerde hatalar ve eksikler vardır. Kısa sürede toparlayıp hızlı bir şekilde yolumuza devam edeceğiz.
    Lütfen gördüğünüz eksik ve hataları aşağıdaki bölüme dönderin. Sırasıyla inceleyip yapılabilirliği varsa üzerinde çalışacağım.
    HATA BİLDİRİM BAŞLIĞI
    Forumdaki kullanıcı adınızla ile giriş yapamıyorsanız kullanıcı adınızın sonuna 1 veya 2 gibi rakamlar ekleyerek deneyin.

    Hepimize Hayırlı Olsun!
    Hüseyin
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

Makro Yardımı

Dunya_

Çok Aktif Üye
Altın Üye
Katılım
19 Ekim 2009
Mesajlar
328
Beğeniler
0
Excel Vers. ve Dili
2007
#1
Merhaba,

İki farklı makroyu tek buton altında çalıştırmak istiyorum ancak kodları birleştiremedim.

1.Kod
Kod:
Sub VeriyeGoreKopya()
 
If [E2] = "" Then
MsgBox "Lütfen Tarih Giriniz!", vbCritical
Range("E2").Select
GoTo 10
Else

'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

'Vardiya Üretim Raporu Bilgisayara Kayıt
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
AyAdi = Format(Date, "mmmm yyyy") & " Vardiya Üretim Raporları"
klasoradi = Format(Date, "dd.mm.yyyy") & " " & [E2]
dosyaadi = [E2] & "  " & [E3]
klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi

ActiveSheet.Range("$B$2:$K$85").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        masaustuyolu & "\" & AyAdi & "\" & dosyaadi & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
        
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
        
'Vardiya Üretim Raporu Servere Kayıt
'Set nesne = CreateObject("Scripting.FileSystemObject")
Server = "\\192.168.1.242\ortak\Üretim"
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
AyAdi = Format(Date, "mmmm yyyy") & " Vardiya Üretim Raporları"
klasoradi = Format(Date, "dd.mm.yyyy") & " " & [E2]
dosyaadi = [E2] & "  " & [E3]
klasorara = nesne.FolderExists(Server & "\" & AyAdi)
If klasorara = False Then nesne.CreateFolder Server & "\" & AyAdi

ActiveSheet.Range("$B$2:$K$85").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Server & "\" & AyAdi & "\" & dosyaadi & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------


'Yazdırma
   'ActiveSheet.PageSetup.PrintArea = "$B$2:$K$85"
    'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
    'IgnorePrintAreas:=False

      
      
' Temizleme

Range( _
        "J5:K5,K46,K47,E2:K4,C9:C13,C15:C21,C23:C26,C28:C31,C33:C35,C37:C39,E9:F13,E15:F21,E23:F26,E28:F31,E33:F35,E37:F39,H9:I13,H15:I21,H23:I25,H26,I26,H28:I30,H31,I31,H33:I34,H35,I35,H37:I39,C60:K61,C63:K64,C66:K67,C69:K70,C72:K72,C75:K75,C78:K78" _
        ).Select
        Selection.ClearContents
    
    Range("C9").Select
    Range("E2").Select
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------


'ActiveCell.FormulaR1C1 = "=TODAY()"
'Range("E15").Select
    
MsgBox "PDF olarak kaydedildi...  Tablo Temizlendi...  İşleminiz tamamlanmıştır..!"




End If
10:
End Sub
2.Kod
Kod:
Private Sub CommandButton1_Click()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  Title = Range("E2") & " - " & Range("E3")

  'PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & " " & [E2] & "  " & [E3] & ".pdf"

  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = "....@gmail.com" ' Kime
    .CC = "....@gmail.com" ' bilgi olarak kime
    .Body = "Selamun aleykum," & vbLf & vbLf _
          & "Bu rapor PDF rapor içermektedir." & vbLf & vbLf _
          & "Hayirli gunler" & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "zaza"
    Else
      MsgBox "E-mail gonderildi", vbInformation, "zaza"
    End If
    On Error GoTo 0
  
  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing




End Sub
Yardımlarınız için teşekkür ederim.
 

turist

Destek Ekibi
Destek Ekibi
Katılım
18 Kasım 2009
Mesajlar
3,469
Beğeniler
47
Excel Vers. ve Dili
Excel2013 English
64Bit
#2
İlk Makroyu silmeyin.
İkinci Makronuzu aşağıdaki gibi düzenleyin.
Eğer gerekirse İlk makrodaki
MsgBox "PDF olarak kaydedildi... Tablo Temizlendi... İşleminiz tamamlanmıştır..!"
satırını silin.
Deneyin.
Rich (BB code):
Private Sub CommandButton1_Click()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
Call VeriyeGoreKopya

  Title = Range("E2") & " - " & Range("E3")

  'PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & " " & [E2] & "  " & [E3] & ".pdf"

  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)

    .Subject = Title
    .To = "....@gmail.com" ' Kime
    .CC = "....@gmail.com" ' bilgi olarak kime
    .Body = "Selamun aleykum," & vbLf & vbLf _
          & "Bu rapor PDF rapor içermektedir." & vbLf & vbLf _
          & "Hayirli gunler" & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "zaza"
    Else
      MsgBox "E-mail gonderildi", vbInformation, "zaza"
    End If
    On Error GoTo 0

  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing




End Sub
 

Dunya_

Çok Aktif Üye
Altın Üye
Katılım
19 Ekim 2009
Mesajlar
328
Beğeniler
0
Excel Vers. ve Dili
2007
#5
Merhaba Hocam,

İkici kodda bulunan
Kod:
Subject = Title
    .To = "....@gmail.com" ' Kime
    .CC = "....@gmail.com" ' bilgi olarak kime
    .Body =
.Body kısmında yazılacak mesajın font ve boyutunu ( Bold 12 ) olarak nasıl değiştirebilirim.

Yardımlarınız için teşekkür ederim.
 
Üst