• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kodu Userform'da Çalıştırma

O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
Aşağıdaki kodu :Userform1'de TextBox1'den sayfa 2 de A12;D12 hücresine -TextBox2'den sayfa 2 de A13;D13 hücresine-TextBox3'den sayfa 2 de A14;D14 hücresinde 'de yine satır genişlemesi olabilir mi? .Yardımlarınızı bekliyorum.Saygılar



Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

Set s1 = Worksheets("Sayfa1")
Set s2 = Worksheets("Sayfa2")

If Target.Address = "$A$1" Then
s1.Range("A12").EntireRow.AutoFit
If s1.Range("A12").Value = Empty Then
s1.Range("A12").EntireRow.AutoFit
Else
With s1.Range("A12").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = s1.Range("A12").ColumnWidth
For Each CurrCell In Range("A12:D12")
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
ElseIf Target.Address = "$A$2" Then
s1.Range("A13").EntireRow.AutoFit
If s1.Range("A13").Value = Empty Then
s1.Range("A13").EntireRow.AutoFit
Else
With s1.Range("A13").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = s1.Range("A13").ColumnWidth
For Each CurrCell In Range("A13:D13")
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End If
End Sub
 
Aşağıdaki kodu :Userform1'de TextBox1'den sayfa 2 de A12;D12 hücresine -TextBox2'den sayfa 2 de A13;D13 hücresine-TextBox3'den sayfa 2 de A14;D14 hücresinde 'de yine satır genişlemesi olabilir mi? .Yardımlarınızı bekliyorum.Saygılar



Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

Set s1 = Worksheets("Sayfa1")
Set s2 = Worksheets("Sayfa2")

If Target.Address = "$A$1" Then
s1.Range("A12").EntireRow.AutoFit
If s1.Range("A12").Value = Empty Then
s1.Range("A12").EntireRow.AutoFit
Else
With s1.Range("A12").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = s1.Range("A12").ColumnWidth
For Each CurrCell In Range("A12:D12")
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
ElseIf Target.Address = "$A$2" Then
s1.Range("A13").EntireRow.AutoFit
If s1.Range("A13").Value = Empty Then
s1.Range("A13").EntireRow.AutoFit
Else
With s1.Range("A13").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = s1.Range("A13").ColumnWidth
For Each CurrCell In Range("A13:D13")
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End If
End Sub
 
Dosya ekleyebilirmisiniz ne demek istediğinizi tam anlayamadım?
 
Ekteki örnek dosyamda userform1'in içerisinde üç adet textbox var.Daha önceden arkadaşların yapmış oldukları başka sayfadan veri girildikçe otamatik olarak diğer sayfadan satır genişlemesi yapan aşağıdaki makroyu userform1'de textbox1'den veri girildiği zaman sayfa1 de a12:d12 satırı otamatik olarak genişleyecek.Yine aynı şekilde textbox2'den veri girildiği zaman sayfa1 de a13:d13 satırı otamatik olarak genişleyecek.Yine son olarak textbox3'den veri girldiği zaman sayfa 1 de a14:a15 satırı otamatik olarak genişleyecek.Yardınlarınızı bekliyorum.Saygılar sunuyorum.İyi geceler
Not:Aşağıdaki kod sayfa2 de a1 ve a2 hücrelerine veri girdiğim za man sayfa 1 de otamatik olarak işlem yapıyor.
 

Ekli dosyalar

Sayın Serget userforma yazmış olduğum bilgiler sayfa1 de gözükmüyo
 
Sayın Serget veri yazdıkça sayfa1 deki satırların açılması gerekiyo
 
ormann' Alıntı:
Sayın Serget veri yazdıkça sayfa1 deki satırların açılması gerekiyo
Genişletmek için tıkla ...

Açılmaktan kastınız nedir anlamadım? textbox'a veri girilince genişlemesi lazım dediniz birde textbox'a girdiğim veri hücrede yazsın dediniz? ikiside oluyor?
 
Sayın Serget Demek istediğim texbox veri girdiğim zaman sayfa1 de a12:D12 birleştirilmş hücreleri verinin çokluğuna ve azlığına göre açılıp-daralacak 1.nolu mesajdaki kod sayfa ikiden veri girdiğimde sayfa 1 de satır genişlemesi yapıyo.Benim İstediğim Sayfa1 den değilde userformdan veri girdiğim zaman aynı işlemi görmesi idi.Bu şekilde 1 nolu mesajdaki kodu userform için uygulayabilirmisiniz?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst