sendkeys kullanımı

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,852
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Merhaba
1 adet userform oluşturun
üstüne bir adet ListBox1 nesnesi ve CommandButton1 nesnesi ekleiyin aşağıdaki kodlarıda userformun kod bölümüne ekleyin form açılınca bilgisayara bağlı yazıcılar listelenecektir. birini seçin ve CommandButton1 düğmesine tıklayın

Kod:
Private Sub CommandButton1_Click()
On Error Resume Next
For j = 1 To ListBox1.ListCount
If ListBox1.Selected(j - 1) = True Then
MsgBox ListBox1.List(j - 1, 0)
yazici = ListBox1.List(j - 1, 0)
Application.ActivePrinter = "LPT1: üzerindeki " & yazici & " "
ActiveWindow.SelectedSheets.PrintOut
ListBox1.Selected(j - 1) = False
Exit Sub
End If
Next


End Sub


Private Sub UserForm_Initialize()
ListBox1.Clear
ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectSingle

    Dim oNetwork As Object, oPrinters As Object
    Dim i As Single, j As Single
    Dim MyPrinters As String
    '
    Set oNetwork = CreateObject("WScript.Network")
    Set oPrinters = oNetwork.EnumPrinterConnections
    '
    For i = 0 To oPrinters.count - 1 Step 2
 
       ListBox1.AddItem oPrinters.Item(i + 1)
         
    Next

'Application.Dialogs(xlDialogPrint).Show
End Sub
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,852
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
1 adet userform oluşturun
üstüne bir adet ListBox1 nesnesi ve CommandButton1 nesnesi ekleyin aşağıdaki kodlarıda userformun kod bölümüne ekleyin form açılınca bilgisayara bağlı yazıcılar listelenecektir. birini seçin ve CommandButton1 düğmesine tıklayın

Konu ile ilgili olarak yukarıdaki kodum da yazıcı seçme işlemi yaparak yazdırmak olarak kodu yazmıştım.

Şimdiki kod da ise yüklü yazıcıları listelemekte ve yazıcı seçimini yapmakta

Kod:
Private Sub CommandButton1_Click()
On Error Resume Next

Dim WSHNetwork
Dim objWMIService
Dim colPrinters
Dim objPrinter

Set WSHNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")

For j = 1 To ListBox1.ListCount
If ListBox1.Selected(j - 1) = True Then
aranan = ListBox1.List(j - 1, 0)
For Each objPrinter In colPrinters

If aranan = objPrinter.name Then

WSHNetwork.SetDefaultPrinter objPrinter.name
MsgBox "varsayılan yazıcı" & Chr(10) & objPrinter.name
'aşğıdaki prosüdürün tırnak işaretini kaldırdığınızda yazıcı yazmaktadır.
'ActiveWindow.SelectedSheets.PrintOut

Exit For
End If
Next
Exit Sub
End If
Next

Set WSHNetwork = Nothing
Set objWMIService = Nothing
Set colPrinters = Nothing

End Sub


Private Sub UserForm_Initialize()

ListBox1.Clear
ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectSingle

Dim i As Single, j As Single
  
Dim WSHNetwork
Dim objWMIService
Dim colPrinters
Dim objPrinter

Set WSHNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
j = colPrinters.count

ReDim deg1(j): ReDim deg2(j)

For Each objPrinter In colPrinters
sat = sat + 1
deg1(sat) = objPrinter.name
Next

m = j
For k = 0 To j - 1
ListBox1.AddItem deg1(m)
m = m - 1
Next
For Each objPrinter In colPrinters
If objPrinter.Default = True Then
aranan = objPrinter.DeviceID
For j = 1 To ListBox1.ListCount
If aranan = ListBox1.List(j - 1, 0) Then
ListBox1.Selected(j - 1) = True
Exit Sub
End If
Next
End If
Next


Set WSHNetwork = Nothing
Set objWMIService = Nothing
Set colPrinters = Nothing

End Sub
Alternatif olarakta aşağıdaki kod yazıcı ayarlarını ve yazıcıları göstermektedir.

Kod:
Sub deneme()

    Application.Dialogs(7).Show
    Application.Dialogs(8).Show
    Application.Dialogs(9).Show

End Sub
Bu kodlar windows xp sp3 ve ofis 2003 de çalışmaktadır diğer versiyonlarda deneme imkanım olmadı.
 
Katılım
20 Aralık 2006
Mesajlar
173
Excel Vers. ve Dili
365 (2016) Türkçe
Aşağıdaki renkli bölüm bende hataya sebep oluyor. Sizde sorun yaratmıyor mu?

Kod:
Application.SendKeys "{tab 3}", [COLOR="Red"]Wait[/COLOR]
Normalde renkli bölüme True yada False yazmak gerekiyor.
merhaba,

Kod:
Application.Wait Now() + TimeValue("00:00:01")
    Application.SendKeys "{tab 3}", Wait
üst satırdaki zaman kadar beklemesi için sonunda wait olması lazım,
bu durumda iken eğer sonuna true yazarsanız bekleme yapmıyor.

bunun amacı hızlı makinalarda tuş basımından önce beklemek.

NOT: amacım sizin gibi bir üstada akıl vermek değil,
konuyu okuyanlar olduğunda bir nebze fayda sağlamak.

Sonuçta ben de bunları çeşitli forumlardan ve denemelerle öğreniyorum...

saygılar.
 
Katılım
20 Aralık 2006
Mesajlar
173
Excel Vers. ve Dili
365 (2016) Türkçe
1 adet userform oluşturun
üstüne bir adet ListBox1 nesnesi ve CommandButton1 nesnesi ekleyin aşağıdaki kodlarıda userformun kod bölümüne ekleyin form açılınca bilgisayara bağlı yazıcılar listelenecektir. birini seçin ve CommandButton1 düğmesine tıklayın

Konu ile ilgili olarak yukarıdaki kodum da yazıcı seçme işlemi yaparak yazdırmak olarak kodu yazmıştım.

Şimdiki kod da ise yüklü yazıcıları listelemekte ve yazıcı seçimini yapmakta

Kod:
Private Sub CommandButton1_Click()
On Error Resume Next

Dim WSHNetwork
Dim objWMIService
Dim colPrinters
Dim objPrinter

Set WSHNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")

For j = 1 To ListBox1.ListCount
If ListBox1.Selected(j - 1) = True Then
aranan = ListBox1.List(j - 1, 0)
For Each objPrinter In colPrinters

If aranan = objPrinter.name Then

WSHNetwork.SetDefaultPrinter objPrinter.name
MsgBox "varsayılan yazıcı" & Chr(10) & objPrinter.name
'aşğıdaki prosüdürün tırnak işaretini kaldırdığınızda yazıcı yazmaktadır.
'ActiveWindow.SelectedSheets.PrintOut

Exit For
End If
Next
Exit Sub
End If
Next

Set WSHNetwork = Nothing
Set objWMIService = Nothing
Set colPrinters = Nothing

End Sub


Private Sub UserForm_Initialize()

ListBox1.Clear
ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectSingle

Dim i As Single, j As Single
  
Dim WSHNetwork
Dim objWMIService
Dim colPrinters
Dim objPrinter

Set WSHNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
j = colPrinters.count

ReDim deg1(j): ReDim deg2(j)

For Each objPrinter In colPrinters
sat = sat + 1
deg1(sat) = objPrinter.name
Next

m = j
For k = 0 To j - 1
ListBox1.AddItem deg1(m)
m = m - 1
Next
For Each objPrinter In colPrinters
If objPrinter.Default = True Then
aranan = objPrinter.DeviceID
For j = 1 To ListBox1.ListCount
If aranan = ListBox1.List(j - 1, 0) Then
ListBox1.Selected(j - 1) = True
Exit Sub
End If
Next
End If
Next


Set WSHNetwork = Nothing
Set objWMIService = Nothing
Set colPrinters = Nothing

End Sub
Alternatif olarakta aşağıdaki kod yazıcı ayarlarını ve yazıcıları göstermektedir.

Kod:
Sub deneme()

    Application.Dialogs(7).Show
    Application.Dialogs(8).Show
    Application.Dialogs(9).Show

End Sub
Bu kodlar windows xp sp3 ve ofis 2003 de çalışmaktadır diğer versiyonlarda deneme imkanım olmadı.
teşekkürler,

problem çözümlenmişti, ancak bir alternatif daha olması kodları incelemek açısından yararlı oldu,

tekrar teşekkürler.
 
Üst