ListBox1.Selected(i) ve Sheets(ListBox1.List(col.Item(i))).PrintOut un listwievdeki k

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
ListBox1.Selected(i) ve Sheets(ListBox1.List(col.Item(i))).PrintOut un listwievdeki karşılıkları nedir?

Kod:
[/FONT]
[LEFT][FONT=Courier New]'######################################################################################################////
Private Sub CommandButton1_Click()                                                                      '##'
Dim col As New Collection                                                                               '##'
'*\ Aktif yazıcıyı değişkene al                                                                         '##'
'Dim DefaultPrint As String:      DefaultPrint = Application.ActivePrinter: MsgBox DefaultPrint         '##'
    With ListBox1                                                                                       '##'
'*\ Listboxta Seçili olanları koleksiyona al ve sayısını tesbit et...                                   '##'
        For i = .ListCount - 1 To 0 Step -1                                                             '##'
            If .Selected(i) Then                                                                        '##'
                Say = Say + 1                                                                           '##'
                col.Add i                                                                               '##'
            End If                                                                                      '##'
        Next i                                                                                          '##'
'*\ ... Eğer sayı 0 a eşitse prosodürden çık, ...                                                       '##'
        If Say = 0 Then                                                                                 '##'
            MsgBox "Seçili veri bulunamadı"                                                             '##'
        Else                                                                                            '##'
            Soru = ComboBox1.Value & " Yazıcısından " & Say & " adet çalışma sayfasından " & _
                   TextBox1.Value & " -er/-ar adet  Yazdırmak İstiyor musunuz?"                         '##'
            If MsgBox(Soru, vbYesNo) = vbYes Then                                                       '##'
'*\ ... Listbox1 de seçili sayfaları combobox1 deki yazıcıdan textbox1 deki kadar yazdır.               '##'
                For i = 1 To col.Count                                                                  '##'
                    Sheets(ListBox1.List(col.Item(i))).PrintOut _
                    Copies:=TextBox1.Value, ActivePrinter:=ComboBox1.Value                              '##'
                Next i                                                                                  '##'
            End If                                                                                      '##'
        End If                                                                                          '##'
    End With    'Listbox1                                                                               '##'
Set col = Nothing                                                                                       '##'
Unload Me                                                                                               '##'
End Sub                                                                                                 '##'
'######################################################################################################////[/FONT][/LEFT]
[FONT=Courier New]

ListBox1.ListCount ============ ListView1.ListItems.Count
ListBox1.Selected(i) ============ ListView1.??????(i)

Sheets(ListBox1.List(col.Item(i))).PrintOut ================ Sheets(ListView1.??????(col.Item(i))).PrintOut
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Çoklu seçim imkanı sunan Listview nesnesinde, seçilmiş elemanların listesini almak için bir döngü kurmalısınız. Şöyle ki;

Kod:
For i = 1 To ListView1.ListItems.Count
    If ListView1.ListItems(i).Selected Then
[COLOR=darkgreen]        'Seçilmiş eleman ne yapılacaksa
        'Kodlar buraya[/COLOR]
    End If
Next i
Seçilen elemanların sheet isimlerini temsil etmesi halinde; yazdırma işlemi kodu da aşağıda verildiği gibi oalcaktır.

Kod:
With ListView1
    For i = 1 To .ListItems.Count
        If .ListItems(i).Selected Then
            Sheets(.ListItems(i)).PrintOut
        End If
    Next i
End With
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
hocam öncelikle geciken cevabım için özür diler, ilginize teşekkür ederim.
ilk döngüde daima 1 sayısı dönüyor


Kod:
With ListView1
For i = 1 To .ListItems.Count
    If .ListItems(i).Selected Then
        MsgBox i
        'Seçilmiş eleman ne yapılacaksa
        'Kodlar buraya
    End If
Next i
End With
ikinci döngüde
Kod:
[LEFT]With ListView1
    if [COLOR=green]SeçSatSay > 0 Then [/COLOR]
    For i = 1 To .ListItems.Count
        If .ListItems(i).Selected Then
[COLOR=red]            Sheets(.ListItems(i)).PrintOut
[/COLOR]        End If
    Next i
    [COLOR=#008000]end if [/COLOR] 
End With[/LEFT]
ayrıca bu satıra kadar seçili satır olsada, olmasadas ulaşıyor, önüne seçili satır yoksa seçili satır yok mesajından sonra atlatma vewrmek lazım ama seçili satır sayısı nasıl tesbit edilir bilimiyorum.
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
ilk döngüde daima 1 sayısı dönüyor
Listview'de tek bir satır seçiliyse, elbet 1 değerini dönecektir. Ayrıca, Lvw'nin multiselect özelliğinin True olup olmadığını kontrol ediniz. Seçili eleman sayısını bulmak için ;

Kod:
With ListView1
    For i = 1 To .ListItems.Count
        If .ListItems(i).Selected Then
            LvwdeSecilenlerinSayisi = LvwdeSecilenlerinSayisi + 1
        End If
    Next i
    MsgBox "Seçili Eleman sayısı : " & LvwdeSecilenlerinSayisi
End With
-------------------------------------------
ayrıca bu satıra kadar seçili satır olsada, olmasadas ulaşıyor, önüne seçili satır yoksa seçili satır yok mesajından sonra atlatma vewrmek lazım ama seçili satır sayısı nasıl tesbit edilir bilimiyorum.
Bu kısmı ise hiç anlamadım ...
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
hocam chekbox özelliğini true olarak kullanıyorum. :(
başka kodmu lazım
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Evet, Hüseyin bey kardeşim , Check ve Multiselect özellikleri farklı şeyler :) Onun için olmaz tabi ...

Az önce verdiğim kodlardaki Selected ifadesini Checked olarak değiştirip
tekrar deneyiniz.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
evet hocam şimdi oldu :

Kod:
Private Sub CommandButton1_Click()                                                                      '##'
With ListView1
    For i = 1 To .ListItems.Count
        If .ListItems(i).Checked Then
            LvwdeSecilenlerinSayisi = LvwdeSecilenlerinSayisi + 1
        End If
    Next i
    If LvwdeSecilenlerinSayisi = "" Then LvwdeSecilenlerinSayisi = 0
    MsgBox "Seçili Eleman sayısı : " & LvwdeSecilenlerinSayisi
End With
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
değerli hocam çekli sayfaları koleksiyona aldım ve yazdır dedim ama printout satırında hata veriyor neden kaynaklıdır?

Kod:
Private Sub CommandButton1_Click()                                                                      '##'
Dim col As New Collection                                                                               '##'
'*\ ListView1de Seçili olanları koleksiyona al ve sayısını tesbit et...                                   '##'
With ListView1
    Say = 0
    For i = 1 To .ListItems.Count
        If .ListItems(i).Checked Then
            Say = Say + 1
            col.Add i
        End If
    Next i
'*\ ... Eğer sayı 0 a eşitse prosodürden çık, ...                                                       '##'
        If Say = 0 Then                                                                                 '##'
            MsgBox "Seçili veri bulunamadı"                                                             '##'
        Else                                                                                            '##'
            Soru = ComboBox1.Value & " Yazıcısından " & Say & " adet çalışma sayfasından " & _
                   TextBox1.Value & " -er/-ar adet  Yazdırmak İstiyor musunuz?"                         '##'
            If MsgBox(Soru, vbYesNo) = vbYes Then                                                       '##'
'*\ ... Listbox1 de seçili sayfaları combobox1 deki yazıcıdan textbox1 deki kadar yazdır.               '##'
                For i = 1 To col.Count                                                                  '##'
'listbox için kullanılan ve çalışan kodlar
'                    Sheets(.List(col.Item(i))).PrintOut _
                    Copies:=TextBox1.Value, ActivePrinter:=ComboBox1.Value                              '##'
''listbox için kullanılan ve çalışmayan kodlar
                    Sheets(.ListItems(col.Item(i))).PrintOut _
                    Copies:=TextBox1.Value, ActivePrinter:=ComboBox1.Value                              '##'
                Next i                                                                                  '##'
            End If                                                                                      '##'
        End If                                                                                          '##'
    End With    'Listbox1                                                                               '##'
Set col = Nothing                                                                                       '##'
Unload Me                                                                                               '##'
End Sub
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Sonunda hallettim, örnek olması için tüm kodları veriyorum.

USERFORM
Kod:
'#########################################################################################################'
'#########         Aktif Çalışma kitabındaki sayfaları Listwieve alır,                            #########'
'#########         ve seçilenleri Combobox1 deki yazıcıdan,                                      #########'
'#########         Textbox1 deki adet kadar yazdırır.                                            #########'
'#########         [URL="http://www.excel.web.tr/hsayar"]www.excel.web.tr/hsayar[/URL] 29/08/2008-12:30.                                     #########'
'#########         Korhan Ayhan Sayesinde "Varsayılan Yazıcı" Comboboxda                         #########'
'#########         açılışta seçiliyor.                                                           #########'
'#########################################################################################################'
Kod:
Private Sub UserForm_Activate()                                                                        '##'
1 Call KlsrDgr                                                                                         '##'
2 Dim dsyIco$:  dsyIco = klsrAddIns & AppPthSept & "Hsr_ico" & AppPthSept & "Print8.ico"   'icon yolu  '##'
3 Call UserformlardaEkOzellik(Me, False, True, True, True, False, True, False, False, True, True _
                              , dsyIco)                                                                '##'
End Sub                                                                                                '##'
'######################################################################################################////
Kod:
Private Sub UserForm_Initialize()                                                                      '##'
'*\ Form denetimlerininin özelliklerini belirle                                                        '##'
    CommandButton2.Cancel = True                 'Userform üzerinde "ESC" ye basınca çıkışa izin ver.  '##'
    TextBox1 = 1:                       CheckBox1.Caption = "Tüm  Sayfaları  Seç"                      '##'
    With ListView1                                                                                     '##'
        .View = lvwReport:              .LabelEdit = lvwManual                                         '##'
        .CheckBoxes = True                                          'Her elemana CheckBox oluşturur.   '##'
        .ColumnHeaders.Clear:           .ListItems.Clear              'başlıkları ve öğeleri temizle   '##'
        .ColumnHeaders.Add , , "Sayfalar", 142                    'başlık ve genişliklerini ayarla     '##'
    End With   'ListView1                                                                              '##'
'*\ Değişken tanımlama ve set etme                                                                     '##'
    Dim Wsh As WshNetwork                                                                              '##'
    Dim i As Single                                                                                    '##'
    Set Wsh = New WshNetwork                                                                           '##'
'Aktif Kitaptaki Sayfa Listesini Listbox1/ListView1 e alır                                             '##'
    For i = 1 To ActiveWorkbook.Sheets.Count                                                           '##'
        ListView1.ListItems.Add , , Sheets(i).Name                                                     '##'
    Next i                                                                                             '##'
'**\ Aktif Bilgisayardaki Yazıcı Listesini Combobox1 e alır                                            '##'
    With ComboBox1                                                                                     '##'
        For i = 1 To Wsh.EnumPrinterConnections.Count - 1 Step 2                                       '##'
            .AddItem Wsh.EnumPrinterConnections(i)                                                     '##'
        Next                                                                                           '##'
'**\ Varsayılan yazıcıyı Combo1e atar                                                                  '##'
        .Value = FncHsr_VarsayilanYazici()                                                             '##'
    End With 'ComboBox1                                                                                '##'
'*\ Değişkenleri ve değerlerini hafızadan silme                                                        '##'
Set Wsh = Nothing:                  i = 0                                                              '##'
End Sub                                                                                                '##'
'######################################################################################################////
Kod:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)                               '##'
    'Call UserForm_EnterKapa2                                                                           '##'
End Sub                                                                                                '##'
'######################################################################################################////
Kod:
Private Sub CommandButton1_Click()                                                                      '##'
1    Dim col As New Collection                                                                               '##'
'*\ ListView1de Seçili olanları koleksiyona al ve sayısını tesbit et...                                 '##'
2 With ListView1                                                                                          '##'
3    For i = 1 To .ListItems.Count                                                                       '##'
4        If .ListItems(i).Checked Then col.Add .ListItems(i).Text                                        '##'
5    Next i                                                                                              '##'
'*\ ... Eğer seçili olan sayfa yoksa prosodürden çık, ...                                               '##'
6        If col.Count = 0 Then                                                                           '##'
7            MsgBox "Seçili veri bulunamadı"                                                             '##'
8        Else                                                                                            '##'
9            Soru = ComboBox1.Value & " Yazıcısından " & col.Count & " adet çalışma sayfasından " & _
                   TextBox1.Value & " -er/-ar adet  Yazdırmak İstiyor musunuz?"                         '##'
10            If MsgBox(Soru, vbYesNo) = vbYes Then                                                       '##'
'*\ ... Listbox1 de seçili sayfaları combobox1 deki yazıcıdan textbox1 deki kadar yazdır.               '##'
11                For i = 1 To col.Count                                                                  '##'
12                     Sheets(col.Item(i)).PrintOut _
                    Copies:=TextBox1.Value, ActivePrinter:=ComboBox1.Value                              '##'
13                Next i                                                                                  '##'
14            End If                                                                                      '##'
15        End If                                                                                          '##'
16    End With    'ListView1                                                                              '##'
17 Set col = Nothing                                                                                      '##'
18 Unload Me                                                                                              '##'
End Sub
'######################################################################################################////
Kod:
Private Sub CheckBox1_Change()
'*\ Chekbox1 seçilince lw1 deki tüm kutular işaretlenir, seçim kaldırılırsa lw1 deki seçimde kaldırılır.'##'
    With ListView1                                                                                      '##'
        For i = 1 To .ListItems.Count                                                                   '##'
            .ListItems(i).Checked = CheckBox1.Value                                                     '##'
        Next i                                                                                          '##'
    End With 'ListView1                                                                                 '##'
'*\ Kutucuklar işaretlenince iptal et yazısı, seçili değilken seç yazısı belirir...                     '##'
    With CheckBox1                                                                                      '##'
        If .Value = True Then                                                                           '##'
            .Caption = "Seçimi  İptal  Et"                                                              '##'
        Else                                                                                            '##'
            .Caption = "Tüm Sayfaları Seç"                                                              '##'
        End If                                                                                          '##'
    End With 'CheckBox1                                                                                 '##'
End Sub                                                                                                 '##'
Kod:
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  '  If KeyCode = 13 Then CommandButton1_Click
End Sub
'######################################################################################################////
Private Sub CommandButton2_Click()
    Unload Me
End Sub
Private Sub Label1_Click()
On Error Resume Next
ActiveWorkbook.FollowHyperlink address:="[URL]http://www.excel.web.tr[/URL]", NewWindow:=True
End Sub
Kod:
Private Sub SpinButton1_SpinDown()
    If TextBox1 = 1 Then
        TextBox1 = 1
    Else
        TextBox1 = Val(TextBox1) - 1
    End If
End Sub
Private Sub SpinButton1_SpinUp()
    TextBox1 = Val(TextBox1) + 1
End Sub
Private Sub SpinButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
     If KeyCode = 13 Then CommandButton1_Click
End Sub
Kod:
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'Textboxın içinde yukarı ok tuşuna basınca değeri bir artır.
    If KeyCode = 38 Then TextBox1 = Val(TextBox1) + 1: KeyCode = 0
'Textboxın içinde aşağı ok tuşuna basınca değeri bir azalt ama değer 1 in altına düşmesin.
    If KeyCode = 40 Then
        If TextBox1 = 1 Then
            TextBox1 = 1: KeyCode = 0
        Else
            TextBox1 = Val(TextBox1) - 1: KeyCode = 0
        End If
    End If
'Textboxın içinde enter tuşuna basınca CommandButton1_Click olayını çalıştır.
    If KeyCode = 13 Then CommandButton1_Click
End Sub
Private Sub ListView1_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
    If KeyCode = 13 Then CommandButton1_Click
End Sub
MODÜL
Kod:
Public Function FncHsr_VarsayilanYazici() As String
'##########################################################################
'##'    Bilgisayardaki varsayılan yazıcıyı döndürür.
'##'    excel.web.tr/Korhanayhan
'##########################################################################
    Dim strReturn As String
    Dim intReturn As Integer
    strReturn = Space(255)
    'This gets the default printer name
    intReturn = GetProfileString("Windows", ByVal "device", "", _
                  strReturn, Len(strReturn))
    If intReturn Then
      'strReturn = UCase(Left(strReturn, InStr(strReturn, ",") - 1))
      strReturn = Left(strReturn, InStr(strReturn, ",") - 1)
    End If
    FncHsr_VarsayilanYazici = strReturn
End Function




buradan indirebilirsiniz
[FONT='Calibri','sans-serif']http://cid-5f022568730f18e0.skydrive.live.com/self.aspx/Ortak/AddIns-VR12092008|_0946.rar[/FONT]
 
Son düzenleme:
Üst