yazma sayfasının ön izlenmesi

[bitmez13]

combobox1 da yazan sayfa ismine göre ön izleme yaptırmak istiyorum hatam nerde bakabilirmisiniz

Private Sub Label55_Click()
On Error Resume Next
Sheets("Me.ComboBox1.Text").Select
For i = 1 To [c65536].End(3).Row
If Cells(i, "c") <> "" Then
SnDlSt = Cells(i, "c").Row
End If
Next i
UserForm1.Hide
Application.Visible = True
Sheets("me.ComboBox1.Text").Select.Range("a1:c" & SnDlSt).PrintPreview
Application.Visible = False
UserForm1.Show
End Sub

 

[N.Ziya Hiçdurmaz]

Yanıt

Private Sub CommandButton1_Click()
If ComboBox1 = "" Then MsgBox "Önce sayfa seçiniz", vbInformation: Exit Sub
Unload Me
Application.Visible = True
Sheets(ComboBox1.Text).PrintPreview
Application.Visible = False
UserForm1.Show
End Sub
Private Sub UserForm_Initialize()
For i = 1 To Sheets.Count
ComboBox1.AddItem Sheets(i).Name
Next
End Sub

 

[bitmez13]

çok teşekkür ederim yanlız çalışmamda aşağıdaki gibi bir satır olduğundan hata veriyor ikisini aynı anda nasıl yazarız teşekkürler

Private Sub UserForm_Initialize()
Dim sh As Worksheet
Me.Caption = "ÖRNEK LISTVIEW ve LISTBOX uygulaması"
For Each sh In Sheets
ComboBox1.AddItem sh.Name

Next
End Sub

 

[N.Ziya Hiçdurmaz]

Yanıt

Kırmızı bölümü silebilirsiniz
Private Sub UserForm_Initialize()
Dim sh As Worksheet
Me.Caption = "ÖRNEK LISTVIEW ve LISTBOX uygulaması"
For Each sh In Sheets
ComboBox1.AddItem sh.Name

Next
End Sub

 

[bitmez13]

teşekkürlerde yine olmadı yine Private Sub UserForm_Initialize()
kısmı hata veriyor

 

[Ayhan Ercan]

Merhaba

Sn N.Ziya Hiçdurmaz hocamın vermiş olduğu kodu aynen kopyalayıp yapıştırmamı yaptınız?

Sizin kodlarınızın arasında Private Sub UserForm_Initialize() prosedürünüzmü var?
Dolayısıyla Initialize prosedürleri 2 ye çıkmış olacaktır ki bununda hata vermesi normal.
Siz kendi yamış olduğunuz prosedürünüzü (Private Sub UserForm_Initialize() ) silin ve öyle deneyiniz..

 

[bitmez13]

bende çift initalize vardı 2 sini birleştirmek istedim diğerini silince silinenin fonksiyonu değişmedi işim oldu teşekkürler yanlız sizleri bulmuşken bir soru daha sorabilirmiyim listviewde çift tıklama ile test box lara gelen veirleri değiştirmek için bir makro buldum kendime uyarlamaya çalıştım ama çalışmıyor onada yardım ederseniz çok sevinirim değiştir makrosuda yine comboboxda çıkan sayfaya göre olacak şekilde ayarlamaya çalıştım


Private Sub CommandButton5_Click()
Dim S1 As Worksheet
Set S1 = Sheets("Me.ComboBox1.Text").Select
'D E Ğ İ Ş T İ R
If TextBox1.Text = "" Then
MsgBox "LÜTFEN ÖNCE LİSTEDEN BİR SEÇİM YAPIN", vbCritical, "D İ K K A T"
ListView1.SetFocus
Exit Sub
End If


On Error Resume Next
If TextBox1.Text = "" Then
MsgBox ("Label1.Text")
TextBox1.SetFocus
Exit Sub

ElseIf TextBox2.Text = "" Then
MsgBox ("Label2.Text"), vbCritical, ("BÖLÜM BOŞ")
TextBox2.SetFocus


Exit Sub
End If


Sheets("Me.ComboBox1.Text").Select
Set S1 = Sheets("Me.ComboBox1.Text")
Dim sat%
On Error GoTo hata

cevap = MsgBox("DEĞİŞTİRMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ ?", vbYesNo, "DEĞİŞTİRME ONAYI")

If cevap = vbNo Then
For tem = 1 To 5
Controls("textbox" & tem) = Empty
Next

TextBox1.Enabled = True
TextBox1.SetFocus

Exit Sub
End If

If cevap = vbYes Then

Dim syd As String
Dim bak As Range
SAY = S1.Cells(65536, "B").End(3).Row
For Each bak In S1.Range("B2:B" & SAY)
ad = S1.Range(bak.Offset(0, 0).Address).Value
syd = S1.Range(bak.Offset(0, 1).Address).Value
' MsgBox ad & Syd
If StrConv(ad, vbUpperCase) = StrConv(TextBox1.Text, vbUpperCase) Then
If StrConv(syd, vbUpperCase) = StrConv(TextBox2.Text, vbUpperCase) Then
bak.Select
S1.Range(bak.Offset(0, 0).Address).Value = TextBox1.Text
S1.Range(bak.Offset(0, 1).Address).Value = TextBox2.Text
S1.Range(bak.Offset(0, 2).Address).Value = TextBox3.Text
S1.Range(bak.Offset(0, 3).Address).Value = TextBox4.Text
S1.Range(bak.Offset(0, 4).Address).Value = TextBox5.Text
MsgBox "VERİNİZ DEĞİŞTİRİLDİ", vbInformation, "YENİLEME"
Exit For
' Exit Sub
End If
End If
Next bak

End If

S1.Range("A2:S65536").Select
Selection.Sort Key1:=S1.Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

SAY = S1.Cells(65536, "A").End(3).Row
ListView1.ListItems.Clear
For i = 2 To SAY
Set liste1 = Me.ListView1.ListItems.Add(, , S1.Cells(i, "A").Value)
liste1.SubItems(1) = S1.Cells(i, "B").Value
liste1.SubItems(2) = S1.Cells(i, "C").Value
liste1.SubItems(3) = S1.Cells(i, "D").Value
liste1.SubItems(4) = S1.Cells(i, "E").Value
liste1.SubItems(5) = S1.Cells(i, "F").Value
'eğer hücre başında (*) işareti var ise satırı mavi renklendir
If Left(S1.Cells(i + 1, 2), 1) = "*" Then
liste1.ListItems(i - 1).ListSubItems(1).ForeColor = vbBlue
liste1.ListItems(i - 1).ForeColor = vbBlue
End If

'eğer hücre başında (-) işareti var ise satırı kırmızı renklendir
If Left(S1.Cells(i + 1, 2), 1) = "-" Then
liste1.ListItems(i - 1).ListSubItems(1).ForeColor = vbRed
liste1.ListItems(i - 1).ForeColor = vbRed
End If

Next i

ListView1.FullRowSelect = True
ListView1.Gridlines = True

MsgBox " ADI = " & TextBox1 & Chr(10) & " SOYADI = " _
& TextBox2, vbInformation, "DEĞİŞTİRME BİLGİLERİ"

sayı = C - 1
Label1 = sayı & " ADET"

For tem = 1 To 5
Controls("textbox" & tem) = Empty
Next

TextBox1.Enabled = True
CommandButton1.Enabled = True
CommandButton4.Enabled = False
TextBox1.SetFocus
TextBox5.Text = ""
hata:

End Sub