Dim 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, 2).End(xlUp).Row + 1
SonStrFormul = WS.Cells(WS.Rows.Count, 36).End(xlUp).Row - 1
WS.Range("A8:AJ" & SonStrFormul).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).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'xlFormatFromLeftOrAbove
SonStrFormul = WS.Cells(WS.Rows.Count, 36).End(xlUp).Row
'
' 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("AJ" & SonStr + 1).Formula = "=sum(AJ7:AJ" & SonStr & ")"
WS.Range("A7").Select
skipfile:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
Set WS = Nothing
Application.ScreenUpdating = True
(20/11/2020, 15:02)hayalibey yazdı: imza bloku kayacaktır zaten.sayın @hayalibey imza bloğuyla ilgili bir sıkıntı var mıydı? sadece satır no alanı olmuyordu
https://resim.accesstr.net/do.php?img=10600