DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub SatırAyarla()
Dim j As Long
Dim n As Long
Dim i As Long
Dim MW As Double
Dim RH As Double
Dim MaxRH As Double
Dim rngMArea As Range
Dim rng As Range
Const SpareCol As Long = 26
Set rng = Range("C12:I" & Range("C" & Rows.Count).End(xlUp).Row)
With rng
For j = 1 To .Rows.Count
If Not .Parent.Rows(.Cells(j, 1).Row).Hidden Then
If Application.WorksheetFunction.CountA(.Rows(j)) Then
MaxRH = 0
For n = .Columns.Count To 1 Step -1
If Len(.Cells(j, n).Value) Then
If .Cells(j, n).MergeCells Then
Set rngMArea = .Cells(j, n).MergeArea
With rngMArea
MW = 0
If .WrapText Then
For i = 1 To .Cells.Count
MW = MW + .Columns(i).ColumnWidth
Next
MW = MW + .Cells.Count * 0.66
With .Parent.Cells(.Row, SpareCol)
.Value = rngMArea.Value
.ColumnWidth = MW
.WrapText = True
.EntireRow.AutoFit
RH = .RowHeight
MaxRH = Application.Max(RH, MaxRH)
.Value = vbNullString
.WrapText = False
.ColumnWidth = 8.43
End With
.RowHeight = MaxRH
End If
End With
ElseIf .Cells(j, n).WrapText Then
RH = .Cells(j, n).RowHeight
.Cells(j, n).EntireRow.AutoFit
If .Cells(j, n).RowHeight < RH Then .Cells(j, n).RowHeight = RH
End If
End If
Next
End If
End If
Next
.Parent.Parent.Worksheets(.Parent.Name).UsedRange
End With
End SubPrivate Sub CommandButton1_Click()
Dim sat As Long
Dim S1 As Worksheet, S2 As Worksheet
On Error Resume Next
Set S1 = Worksheets("VERÝ")
Set S2 = Worksheets("RAPOR")
S2.Range("c12") = Replace(Replace(Replace(TextBox1.Text, Chr(13), " "), Chr(32), " "), Chr(9), " ") 'ÖZÜ-1
S2.Range("c14") = Replace(Replace(Replace(TextBox2.Text, Chr(13), " "), Chr(32), " "), Chr(9), " ") 'ÖZÜ-1
S2.Range("c16") = Replace(Replace(Replace(TextBox3.Text, Chr(13), " "), Chr(32), " "), Chr(9), " ") 'ÖZÜ-1
Sheets("rapor").Select
[B][COLOR="Red"]Call SatırAyarla[/COLOR][/B] ' Module1 deki kodu çalıştırır.
End Sub