• DİKKAT

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

Satır Açma Makrosunda Düzenleme

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
Ekteki örnek dosyamda veri girişi sayfasından a1 hücresinden metin girdiğim zaman a4 sayfasında c19 hücresinde satır açılması oluyor. Benim istediğim aynı makronun içerisine veri girişi sayfasından a2,a3,a4,a5,a6 hücrelerinede veri girdiğimde yine a4 sayfasında c26,c29,c30,c31,c32 satırlarındada aynı satır açılması olmasıdır.Eğer veri girişinde a1,a2,a3,a4,a5,a6 hücrelerine veri girilmediği zaman ise a4 sayfasında veri girilmeyen satırlar gizlenebilir mi ?

Sub deneme_MTK()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

Worksheets("a4").Activate
Range("c19").Select
ActiveCell.EntireRow.AutoFit
If ActiveCell.Value = Empty Then
ActiveCell.EntireRow.AutoFit
Else
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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
Worksheets("VERİ GİRİŞİ").Activate
Sheets("a4").Select
ActiveWindow.SelectedSheets.PrintPreview

End Sub
 

Ekli dosyalar

Aynı işlemi diğer satırlarda da uygulayabilirmiyiz ?
 
Sayın arkadaşlar 1.nolu mesajımdaki makronun düzenlemesine rica etsem yardımcı olabilirmisiniz?
 
Geri
Üst