userform üzerindeki buton ile kodun içinde değişiklik mümkün mü?

Katılım
4 Mayıs 2007
Mesajlar
234
Excel Vers. ve Dili
office 2007 64 bit
office 2010 64 bit
Altın Üyelik Bitiş Tarihi
14-09-2023
iyi günler arkadaşlar,
userform1 üzerinde 100 tane buton var ve her bir buton bir sayfa için buton 1 e tıklandıgında userform2 nin içindeki gönder butonun kodundaki Sheets("SAYFA1").Select buton 2 ye tıkladıgımda ise Sheets("SAYFA2").Select olması münkün mü aceba. eğer mümkün ise butona nasıl bi kod eklemem gereklidir aceba...

Değiştirmek istediğim bölge aşşağıdaki kodda KIRMIZ renkli olan yerdir.
saygılarımla..

Private Sub GÖNDER1_Click()

Sheets("BEKLEME").Select

Range("A6:D6").Select
Selection.Copy
Sheets("PRİNT").Select
Range("A1:D1").Select
ActiveSheet.Paste
Sheets("BEKLEME").Select
Range("A4").Select
Selection.Copy
Sheets("PRİNT").Select
Range("C2").Select
ActiveSheet.Paste
With Selection.Font
.Size = 8
End With
Range("A2") = Format(Now, "hh:mm")
Application.ScreenUpdating = False
Range("A1:D1").Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

Dim S1 As Worksheet
Dim S2 As Worksheet
Dim i, S2sonsat, S1sonsat
Set S1 = Sheets("ANA")
Set S2 = Sheets("BEKLEME")
Set S3 = Sheets("PRİNT")
s3_sat = 3
s2_son = S2.[B65536].End(3).Row - 1

For i = 11 To s2_son
For a = 1 To 400
If S2.Cells(i, "B") = S1.Cells(a, "b") Then

S3.Cells(s3_sat, "a") = S2.Cells(i, "a")
S3.Cells(s3_sat, "b") = S2.Cells(i, "b")
s3_sat = s3_sat + 1

Else: End If
Next a
Next i

Set S1 = Nothing
Set S3 = Nothing
Set S2 = Nothing
s3_sat = Empty
s2_son = Empty
i = Empty
a = Empty

Application.ScreenUpdating = True

Sheets("PRİNT").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Columns("A:D").Select
Range("A2").Activate
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1:D1").Select

Sheets("BEKLEME").Select

Dim c As Range, sat As Long

Set c = [A:A].Find("y")
If Not c Is Nothing Then
sat = c.Row
End If

If sat = 11 Then Exit Sub
Rows("11:" & sat - 1).Copy

Sheets("SAYFA1").Select


Rows("11:11").Select
Selection.Insert Shift:=xlDown
ActiveSheet.PasteSpecial

Dim X, son

son = Cells(Rows.Count, "D").End(3).Row

If son <= 11 Then Exit Sub

For X = son To 11 Step -1
Cells(X, 1) = WorksheetFunction.SumIf(Range("B:B"), Cells(X, "B"), Range("A:A"))
Cells(X, 4) = WorksheetFunction.SumIf(Range("B:B"), Cells(X, "B"), Range("D:D"))
If WorksheetFunction.CountIf(Range("B" & son & ":B" & X), Cells(X, "B")) > 1 Then
Rows(X).Delete
End If

Next
Range("E1").Select
Sheets("BEKLEME").Select
Range("A11").Select
If sat = 11 Then Exit Sub
Rows("11:" & sat - 1).Delete Shift:=xlUp

Unload Me

End Sub
 
Katılım
4 Mayıs 2007
Mesajlar
234
Excel Vers. ve Dili
office 2007 64 bit
office 2010 64 bit
Altın Üyelik Bitiş Tarihi
14-09-2023
Demek ki mümkün değilmiş. teşekürler.. saygılarımla..
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
commandbuttonun Properties Tag özelliğine seçilecek sayfa adını yazın.
Mesela commandbuton1 in Tag özelliğine Sayfa1 yazın diğerlerinede tag özelliklerine yazın.
Commandbuton1 in içindeki kod aşağıdaki gibi olmalı.
Kod:
Sheets(CommandButton1.Tag).Select
Commandbuton2nin içindeki kod;
Kod:
Sheets(CommandButton2.Tag).Select
 
Katılım
4 Mayıs 2007
Mesajlar
234
Excel Vers. ve Dili
office 2007 64 bit
office 2010 64 bit
Altın Üyelik Bitiş Tarihi
14-09-2023
çok teşekür ediyorum sayın hocam saolun
 
Üst