- Katılım
- 5 Mayıs 2022
- Mesajlar
- 4
- Excel Vers. ve Dili
- vba
merhabalar.
yazdığım program bakım kayıtlarının tutulduğu aynı zamanda arıza kayıtlarının oluşturulduğu bir konuyu kapsıyor benden istenilen arıza kaydı oluşturulduğunda istenilen whatsapp gruplarına girilen arıza kaydı verilerinin gönderilmesi.
arıza kaydı oluşturmada izlediğimim metodu şu şekilde açıklamaya çalışım. arıza kaydı oluştur butonuna aşağıdaki kodlama yöntemiyle çalıştırıyorum call arıza_gonder module ise yeni oluşturduğum ariakaydı adlı excelden veri alması gerekirken aktif olan safydana boş veri çekiyor burda sayfa referanslaması yapamadım bu konuda yardımcı olursanız çok sevinirim en altta ariza_gönder modulunun kodlarını paylaşıyorum.
Private Sub CommandButton25_Click()
On Error Resume Next
Dim baglan As New Connection
Dim rs As New Recordset
Dim sh As Worksheet
sh.Activate
If TextBox28 <> "" And TextBox29 <> "" And TextBox30 <> "" And ComboBox13.Value <> "" And ComboBox14.Value <> "" And TextBox27 <> "" Then
baglan.Open "Provider=Microsoft.Ace.Oledb.12.0;data source=C:\Users\"volkan"\Desktop\master.accdb;"
rs.Open "select * from arzkyd where Kimlik", baglan, adOpenKeyset, adLockPessimistic
rs.AddNew
rs.Fields(1) = Me.TextBox28.Text
rs.Fields(2) = Me.TextBox29.Text
rs.Fields(3) = Me.TextBox30.Text
rs.Fields(4) = Me.ComboBox13.Text
rs.Fields(5) = Me.ComboBox14.Text
rs.Fields(6) = Me.TextBox27.Text
rs.Update
secim = "ArizaKaydi"
Set yeniexcel = Workbooks.Add
With yeniexcel
.SaveAs Filename:="C:\Users\Volkan\Desktop\Raporlar\" & secim & ".xlsx"
.Close
End With
Set objxl = CreateObject("excel.application")
With objxl
.Visible = False
.Workbooks.Open "C:\Users\"volkan"\Desktop\Raporlar\" & secim & ".xlsx"
.ActiveSheet.Range("t1").Value = "volkan"
.ActiveSheet.Range("a1").Value = "ID Numarası:"
.ActiveSheet.Range("b1").Value = "Arıza Bildirimi Yapan:"
.ActiveSheet.Range("c1").Value = "Arıza Bildirim Tarihi:"
.ActiveSheet.Range("d1").Value = "Arıza Bildirim Saati:"
.ActiveSheet.Range("e1").Value = "Makine Adı:"
.ActiveSheet.Range("f1").Value = "Arıza Türü:"
.ActiveSheet.Range("g1").Value = "Arıza Tanımı:"
.ActiveSheet.Range("A2").CopyFromRecordset rs
.Range("a:g").Columns.AutoFit
.ActiveWorkbook.Save
.ActiveWorkbook.Close
ThisWorkbook.Application.Visible = False
ThisWorkbook.Application.Hide
End With
rs.Close
baglan.Close
Call arıza_gonder
Call gonder
Call hub
Kill "C:\Users\volkan\Desktop\Raporlar\*.*"
Me.TextBox28.Text = ""
Me.ComboBox13.Clear
Me.ComboBox14.Clear
Me.TextBox29.Text = ""
Me.TextBox30.Text = ""
Me.TextBox27.Text = ""
Else
MsgBox "ALANLARI DOLDURUNUZ !"
End If
End Sub
Sub arıza_gonder()
Dim kime As String
Dim metin As String
Dim w2 As Workbook
Dim s2 As Worksheet
ActiveSheet.Range("F1").Value = "esim"
Set w2 = Workbooks("C:\Users\Volkan\Desktop\Raporlar\" & ArizaKaydi & ".xlsx")
Set s2 = Worksheets(1)
kime = Sheets("Sayfa1").Range("F1").Text
metin = s2.Range("A1:G2").Copy
ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/"
Application.Wait (Now + TimeValue("00:00:10"))
Call SendKeys("{TAB}", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys(kime, True)
Application.Wait (Now + TimeValue("00:00:03"))
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^+v", True)
Application.Wait (Now + TimeValue("00:00:03"))
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^+w", True)
End Sub
yazdığım program bakım kayıtlarının tutulduğu aynı zamanda arıza kayıtlarının oluşturulduğu bir konuyu kapsıyor benden istenilen arıza kaydı oluşturulduğunda istenilen whatsapp gruplarına girilen arıza kaydı verilerinin gönderilmesi.
arıza kaydı oluşturmada izlediğimim metodu şu şekilde açıklamaya çalışım. arıza kaydı oluştur butonuna aşağıdaki kodlama yöntemiyle çalıştırıyorum call arıza_gonder module ise yeni oluşturduğum ariakaydı adlı excelden veri alması gerekirken aktif olan safydana boş veri çekiyor burda sayfa referanslaması yapamadım bu konuda yardımcı olursanız çok sevinirim en altta ariza_gönder modulunun kodlarını paylaşıyorum.
Private Sub CommandButton25_Click()
On Error Resume Next
Dim baglan As New Connection
Dim rs As New Recordset
Dim sh As Worksheet
sh.Activate
If TextBox28 <> "" And TextBox29 <> "" And TextBox30 <> "" And ComboBox13.Value <> "" And ComboBox14.Value <> "" And TextBox27 <> "" Then
baglan.Open "Provider=Microsoft.Ace.Oledb.12.0;data source=C:\Users\"volkan"\Desktop\master.accdb;"
rs.Open "select * from arzkyd where Kimlik", baglan, adOpenKeyset, adLockPessimistic
rs.AddNew
rs.Fields(1) = Me.TextBox28.Text
rs.Fields(2) = Me.TextBox29.Text
rs.Fields(3) = Me.TextBox30.Text
rs.Fields(4) = Me.ComboBox13.Text
rs.Fields(5) = Me.ComboBox14.Text
rs.Fields(6) = Me.TextBox27.Text
rs.Update
secim = "ArizaKaydi"
Set yeniexcel = Workbooks.Add
With yeniexcel
.SaveAs Filename:="C:\Users\Volkan\Desktop\Raporlar\" & secim & ".xlsx"
.Close
End With
Set objxl = CreateObject("excel.application")
With objxl
.Visible = False
.Workbooks.Open "C:\Users\"volkan"\Desktop\Raporlar\" & secim & ".xlsx"
.ActiveSheet.Range("t1").Value = "volkan"
.ActiveSheet.Range("a1").Value = "ID Numarası:"
.ActiveSheet.Range("b1").Value = "Arıza Bildirimi Yapan:"
.ActiveSheet.Range("c1").Value = "Arıza Bildirim Tarihi:"
.ActiveSheet.Range("d1").Value = "Arıza Bildirim Saati:"
.ActiveSheet.Range("e1").Value = "Makine Adı:"
.ActiveSheet.Range("f1").Value = "Arıza Türü:"
.ActiveSheet.Range("g1").Value = "Arıza Tanımı:"
.ActiveSheet.Range("A2").CopyFromRecordset rs
.Range("a:g").Columns.AutoFit
.ActiveWorkbook.Save
.ActiveWorkbook.Close
ThisWorkbook.Application.Visible = False
ThisWorkbook.Application.Hide
End With
rs.Close
baglan.Close
Call arıza_gonder
Call gonder
Call hub
Kill "C:\Users\volkan\Desktop\Raporlar\*.*"
Me.TextBox28.Text = ""
Me.ComboBox13.Clear
Me.ComboBox14.Clear
Me.TextBox29.Text = ""
Me.TextBox30.Text = ""
Me.TextBox27.Text = ""
Else
MsgBox "ALANLARI DOLDURUNUZ !"
End If
End Sub
Sub arıza_gonder()
Dim kime As String
Dim metin As String
Dim w2 As Workbook
Dim s2 As Worksheet
ActiveSheet.Range("F1").Value = "esim"
Set w2 = Workbooks("C:\Users\Volkan\Desktop\Raporlar\" & ArizaKaydi & ".xlsx")
Set s2 = Worksheets(1)
kime = Sheets("Sayfa1").Range("F1").Text
metin = s2.Range("A1:G2").Copy
ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/"
Application.Wait (Now + TimeValue("00:00:10"))
Call SendKeys("{TAB}", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys(kime, True)
Application.Wait (Now + TimeValue("00:00:03"))
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^+v", True)
Application.Wait (Now + TimeValue("00:00:03"))
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^+w", True)
End Sub