Excel Sitesi ve Forumu yayında.
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()
Sub YeniDosyaOlusturVeriYaz()
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(1, 1).Value = "ExcelSitesi.Com"
objExcel.Cells(1, 1).Interior.Color = vbGreen
objExcel.Cells(1, 1).Font.Color = vbWhite
End Sub
Sub ExcelDosyasindanVeriAl()
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\ExcelSitesi\Test.xlsx")
satir = 1
Do Until objExcel.Cells(satir, 1).Value = ""
ThisWorkbook.ActiveSheet.Range("A" & satir).Value = objExcel.Cells(satir, 1).Value
ThisWorkbook.ActiveSheet.Range("B" & satir).Value = objExcel.Cells(satir, 2).Value
satir = satir + 1
Loop
End Sub
objExcel.Application.Run "'Excel dosyasının tam yolu'!modul adı.makro adı"
Set objExcel = CreateObject("Excel.Application")
objExcel.Application.Run "'C:\Kullanıcılar\ExcelSitesi\Desktop\MakroluDosya.xlsm'!Module1.Makrom"
objExcel.DisplayAlerts = False
objExcel.Application.Quit
Set objExcel = Nothing
Sub EXCELCE_ADSOYAD_AYIR()
Dim BULENT, EXCELCE, ad As Long
Dim DEGIS, ADI As String
Dim AYIR() As String
Columns("B:C").ClearContents
'TÜRKÇE KARAKTER DEĞİŞTİR-EXCELCE.NET:
For BULENT = 1 To Cells(65536, 1).End(xlUp).Row
DEGIS = Cells(BULENT, 1).Value
DEGIS = VBA.Replace(DEGIS, "Ç", "C")
DEGIS = VBA.Replace(DEGIS, "ç", "c")
DEGIS = VBA.Replace(DEGIS, "Ğ", "G")
DEGIS = VBA.Replace(DEGIS, "ğ", "g")
DEGIS = VBA.Replace(DEGIS, "İ", "I")
DEGIS = VBA.Replace(DEGIS, "ı", "i")
DEGIS = VBA.Replace(DEGIS, "Ö", "O")
DEGIS = VBA.Replace(DEGIS, "ö", "o")
DEGIS = VBA.Replace(DEGIS, "Ü", "U")
DEGIS = VBA.Replace(DEGIS, "ü", "u")
DEGIS = VBA.Replace(DEGIS, "Ş", "S")
DEGIS = VBA.Replace(DEGIS, "ş", "s")
'YAZIM DÜZENİ-EXCELCE.NET:
DEGIS = StrConv(DEGIS, vbProperCase)
Cells(BULENT, 1).Value = DEGIS
Next BULENT
'AYIR:
For EXCELCE = 1 To Cells(65536, 1).End(xlUp).Row
AYIR = Split(Cells(EXCELCE, 1), " ")
KACBOSLUKVAR = UBound(AYIR)
If KACBOSLUKVAR = 0 Then
Cells(EXCELCE, 2).Value = Cells(EXCELCE, 1)
Else
Cells(EXCELCE, 3).Value = AYIR(KACBOSLUKVAR)
For ad = 0 To KACBOSLUKVAR - 1
ADI = ADI & AYIR(ad) & " "
Next ad
Cells(EXCELCE, 2).Value = ADI
End If
ADI = ""
Next EXCELCE
MsgBox "İşlem tamamlandı", vbInformation, "Excelce.Net"
End Sub