20/11/2020, 21:20
çerçevelerin oluşmasını engellemek için öncelikle çerçeve istemediğiniz sayfalarda yer alan aşağıdaki kodu silmelisiniz, gerekli kod Sayfa Hazırla butonuna eklenmiştir
Bu arada mümkünse konu açarken eklediğiniz Yeşil kalkan simgesini kullanmayın, o simge cevaplanmış mesajların sembolü olduğunda görünce cevaplanmış sanıp konuyu atlayabiliyor insan. En azından bir kaç kez ben cevaplanmış sanıp geçtim)
Private Sub Worksheet_Change(ByVal Target As Range)
''''''''''''''''''Satırlara Tablo Yapmak''''''''''''''''''''''''''''''''''''''''''
Range("A2:AJ10000").Borders.LineStyle = 0
Range("A2:AJ" & [B10000].End(3).Row).Borders.LineStyle = 1
Range("A2:AJ" & [B10000].End(3).Row).Borders.LineStyle = xlContinuous
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End SubDim Sql As String
Dim SyfAdi As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
Dim WS As Worksheet
SyfAdi = Me.ComboBox1.Value
Set WS = ThisWorkbook.Sheets(SyfAdi)
SonStr = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row - 2
WS.Range("A8:AJ" & SonStr).Select
Selection.EntireRow.Delete
Application.ScreenUpdating = False
SQL = "SELECT cdbl([VERi$].[F2]), [VERi$].[F5], [VERi$].[F3], [VERi$].[F4],1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 " & _
"FROM [KONTROL$B2:C] INNER JOIN ((([VERi$] " & _
"LEFT JOIN [KONTROL$E2:E] ON [VERi$].[F6] = [KONTROL$E2:E].[F1]) " & _
"LEFT JOIN [KONTROL$F2:F] ON [VERi$].[F5] = [KONTROL$F2:F].[F1]) " & _
"LEFT JOIN [KONTROL$G2:G] ON [VERi$].[F2] = [KONTROL$G2:G].[F1]) ON [KONTROL$B2:C].[F2] = [VERi$].[F5] " & _
"WHERE ([VERi$].[F1] Is Not Null) and (([KONTROL$E2:E].[F1]) Is Null) and (([KONTROL$F2:F].[F1]) Is Null) and (([KONTROL$G2:G].[F1]) Is Null) " & _
"ORDER BY Clng([KONTROL$B2:C].[F1]), cdbl([VERi$].[F2])"
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 12.0;hdr=no;IMEX=1"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
WS.Rows("8:" & 5 + ADO_RS.RecordCount + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'xlFormatFromLeftOrAbove
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
GoTo skipfile:
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst
ADO_RS.MoveNext
WS.Range("B7").CopyFromRecordset ADO_RS
SonStr = 7 + ADO_RS.RecordCount - 2
WS.Range("A7") = 1
WS.Range(WS.Cells(8, "A"), WS.Cells(SonStr, "A")).Formula = "=A7+1"
WS.Range(WS.Cells(7, "Aj"), WS.Cells(SonStr, "Aj")).Formula = "=sum(F7:Ai7)"
WS.Range(WS.Cells(7, "Aj"), WS.Cells(SonStr, "Aj")).Interior.color = WS.Range("AJ7").Interior.color
WS.Range("A7").Select
''''''''''''''''''Satırlara Tablo Yapmak''''''''''''''''''''''''''''''''''''''''''
WS.Range("A1:AJ" & SonStr + 20).Borders.LineStyle = 0
WS.Range("A5:AJ" & SonStr).Borders.LineStyle = 1
WS.Range("A5:AJ" & SonStr).Borders.LineStyle = xlContinuous
WS.Range("A7:AJ" & SonStr).HorizontalAlignment = xlCenter
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
skipfile:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
Set WS = Nothing
Application.ScreenUpdating = TrueBu arada mümkünse konu açarken eklediğiniz Yeşil kalkan simgesini kullanmayın, o simge cevaplanmış mesajların sembolü olduğunda görünce cevaplanmış sanıp konuyu atlayabiliyor insan. En azından bir kaç kez ben cevaplanmış sanıp geçtim)