Haberler:

Excel Sitesi ve Forumu yayında. ;)

Mobil Ana Menü

Son İletiler

Sayfa 1 ... 3 4 5 6
#41
Excel - Vba - Vbs Örnek Kodları / Makro ile Yazıcı Seçmek
Son İleti Gönderen ExcelSitesi - Ekm 24, 2017, 01:06 ÖS
Aşağıdaki kod ile sayfaları yazdırırken varsayılan değil de istediğimiz yazıcıya çıktımızı gönderebiliriz.

Sub Yazdir()
Worksheets("ExcelSitesi.com").PrintOut ActivePrinter:="Microsoft XPS Document Writer"
End Sub
#42
Excel - Vba - Vbs Örnek Kodları / Hücrede tekrarlananları teke i...
Son İleti Gönderen ExcelSitesi - Ekm 18, 2017, 10:19 ÖS
Aşağıdaki kod ile aynı hücre içinde tekrar eden verileri, satır satır tarayarak teke indirebiliriz:


Kod Seç
Sub ExcelSitesiTekrarlariSil()
   Dim arr1, arr2
   For bulent = 1 To ActiveSheet.Range("A65530").End(3).Row
       arr1 = VBA.Split(Range("A" & bulent).Value, " ")
       arr2 = removeDuplicates(arr1)
       Range("B" & bulent).Value = Join(arr2, " ")
   Next bulent
End Sub

Function removeDuplicates(ByVal myArray As Variant) As Variant
Dim d As Object
Dim v As Variant
Dim outputArray() As Variant
Dim i As Integer

Set d = CreateObject("Scripting.Dictionary")
For i = LBound(myArray) To UBound(myArray)
   d(myArray(i)) = 1
Next i
i = 0
For Each v In d.Keys()
   ReDim Preserve outputArray(0 To i)
   outputArray(i) = v
   i = i + 1
Next v
removeDuplicates = outputArray
End Function

#43
Excel - Vba - Vbs Örnek Kodları / Ynt: Excel'i Konuşturmak / Spe...
Son İleti Gönderen Bülent - Ekm 08, 2017, 05:17 ÖS
Kod Seç
Sub Exceli_Konustur()

Application.Speech.Speak ThisWorkbook.FullName

Application.Speech.Speak ("1, 2, 3, 4")

Application.Speech.Speak ("ExcelSitesi.com bir numara. En büyük, en güzel, en harika...")

End Sub
#44
Excel - Vba - Vbs Örnek Kodları / Excel'i Konuşturmak / Speech.S...
Son İleti Gönderen Bülent - Ekm 08, 2017, 05:15 ÖS
Excel'i Konuşturmak, hücre değerlerini veya belli bir yazıyı okutmak için:

Kod Seç
Sub Exceli_Konustur()
Application.Speech.Speak ("ExcelSitesi.com bir numara. En büyük, en güzel, en harika...")
End Sub
#45
Excel - Vba - Vbs Örnek Kodları / Excel ile Outlook'ta Yeni Mail...
Son İleti Gönderen Bülent - Ekm 08, 2017, 05:08 ÖS
Excel ile Outlook'ta Yeni Mail Oluşturmak/Göndermek:

Kod Seç
Sub Excel_ile_Outlookta_Mail_Olustur()
    Dim OutlookUygulamasi As Object
    Dim YeniMail As Object

    Set OutlookUygulamasi = CreateObject("Outlook.Application")
    Set YeniMail = OutlookUygulamasi.CreateItem(0)

    On Error Resume Next
    With YeniMail
        .to = "admin@excelsitesi.com"
        .CC = ""
        .BCC = ""
        .Subject = "Mail Başlığı"
        .Body = "ExcelSitesi.Com mail denemesi"
        .Attachments.Add ("C:\ExcelSitesi\Ek1.xls")
        .Display 'Görüntülemek için
        '.Send   Göndermek için
    End With
    On Error GoTo 0

    Set YeniMail = Nothing
    Set OutlookUygulamasi = Nothing
End Sub
#46
Excel - Vba - Vbs Örnek Kodları / Excel ile Outlook'a Görev Ekle...
Son İleti Gönderen Bülent - Ekm 08, 2017, 05:01 ÖS
Excel ile Outlook'a Görev Eklemek:

Kod Seç
Sub ExceldenOutlookaGorevEkle()
Const olTaskItem = 3

Set objOutlook = CreateObject("Outlook.Application")
Set objTask = objOutlook.CreateItem(olTaskItem)

objTask.Subject = "Outlook Görev Ekleme Denemesi"
objTask.Body = "Outlook görev ekleme denemesi olarak yapılmıştır."
objTask.ReminderSet = True
objTask.ReminderTime = #9/11/2017 12:00:00 PM#
objTask.DueDate = #10/11/2005 12:00:00 PM#
objTask.ReminderPlaySound = True
objTask.ReminderSoundFile = "C:\ExcelSitesi\Media\Ding.wav"

objTask.Save

End Sub

#47
Excel - Vba - Vbs Örnek Kodları / VBS ile Text Dosyası (txt) Olu...
Son İleti Gönderen Bülent - Ekm 08, 2017, 04:49 ÖS
VBS ile Text Dosyası (txt) Oluşturmak:

Kod Seç
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\ExcelSitesi\TextDosyam.txt")
#48
Excel - Vba - Vbs Örnek Kodları / VBS ile Active Directory Bilgi...
Son İleti Gönderen Bülent - Ekm 08, 2017, 04:46 ÖS
VBS ile Active Directory bilgilerini Excel'e almak için:

Kod Seç
' List Active Directory Data in a Spreadsheet


Const ADS_SCOPE_SUBTREE = 2

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True
objExcel.Workbooks.Add

objExcel.Cells(1, 1).Value = "Last name"
objExcel.Cells(1, 2).Value = "First name"
objExcel.Cells(1, 3).Value = "Department"
objExcel.Cells(1, 4).Value = "Phone number"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
    "SELECT givenName, SN, department, telephoneNumber FROM " _
        & "'LDAP://dc=fabrikam,dc=microsoft,dc=com' WHERE " _
            & "objectCategory='user'" 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
x = 2

Do Until objRecordSet.EOF
    objExcel.Cells(x, 1).Value = _
        objRecordSet.Fields("SN").Value
    objExcel.Cells(x, 2).Value = _
        objRecordSet.Fields("givenName").Value
    objExcel.Cells(x, 3).Value = _
        objRecordSet.Fields("department").Value
    objExcel.Cells(x, 4).Value = _
        objRecordSet.Fields("telephoneNumber").Value
    x = x + 1
    objRecordSet.MoveNext
Loop

Set objRange = objExcel.Range("A1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("C1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("D1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("A1").SpecialCells(11)
Set objRange2 = objExcel.Range("C1")
Set objRange3 = objExcel.Range("A1")
#49
Excel - Vba - Vbs Örnek Kodları / Ynt: VBS ile İşletim Sistemini...
Son İleti Gönderen Bülent - Ekm 08, 2017, 04:44 ÖS
Kod Seç
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

x = 1
strComputer = "."
Set objWMIService = GetObject _
    ("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServices = objWMIService.ExecQuery _
    ("Select * From Win32_Service")

For Each objService in colServices
    objExcel.Cells(x, 1) = objService.Name
    objExcel.Cells(x, 2) = objService.State
    x = x + 1
Next
#50
Excel - Vba - Vbs Örnek Kodları / VBS ile İşletim Sisteminin Ser...
Son İleti Gönderen Bülent - Ekm 08, 2017, 04:43 ÖS
VBS ile İşletim Sisteminin Servislerini ve Çalışma Durumlarını Listelemek:

Kod Seç
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
x = 1

strComputer = "."
Set objWMIService = _
    GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
    ("Select * from Win32_Service")
For Each objItem in colItems
    objWorksheet.Cells(x, 1) = objItem.Name
    objWorksheet.Cells(x, 2) = objItem.DisplayName
    objWorksheet.Cells(x, 3) = objItem.State
    x = x + 1
Next

Set objRange = objWorksheet.UsedRange
objRange.EntireColumn.Autofit()
Sayfa 1 ... 3 4 5 6