hadishirdel
دوشنبه 17 آذر 1399, 10:52 صبح
مشکل این کد چیه که اجرا نمی شود؟ub Button18_Click()Worksheets("data").Range("A1:Z200").Clear
'Create Variables for the Form'
Dim dbInstance As String
Dim dbDatabase As String
Dim dbLogin As String
Dim dbPassword As String
Dim dbQuery As String
Dim oldmonth As String
Dim newmonth As String
Dim CodePayID As String
Dim EmptypeCode(7) As Integer
Dim EmptypeCode1, EmptypeCode2, EmptypeCode3, EmptypeCode4, EmptypeCode5, EmptypeCode6, EmptypeCode7 As Integer
If checkbox31 = True Then
EmptypeCode(0) = 1
End If
If checkbox33 = True Then
EmptypeCode(1) = 2
End If
If checkbox34 = True Then
EmptypeCode(2) = 3
End If
If checkbox35 = True Then
EmptypeCode(3) = 8
End If
If checkbox36 = True Then
EmptypeCode(4) = 9
End If
If checkbox37 = True Then
EmptypeCode(5) = 18
End If
If checkbox38 = True Then
EmptypeCode(6) = 31
End If
'Attach inputs to the variables
dbInstance = Sheet1.Range("b3").Value
dbDatabase = Sheet1.Range("b2").Value
' dbLogin = LoginTxt.Value
'dbPassword = PasswordTxt.Value
'dbQuery = QueryTxt.Value
oldmonth = Sheet1.Range("g2").Value
newmonth = Sheet1.Range("f2").Value
CodePayID = Sheet1.Range("k2").Value
'Declare variables'
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Dim iCols As Integer
Dim tbl As ListObject
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection'
Dim myConnectionString As String
myConnectionString = "Provider=SQLOLEDB; Data Source=" & dbInstance & ";" & "Initial Catalog=" & dbDatabase & ";" & "Integrated Security=SSPI;"
'sConnString = "Provider=SQLOLEDB;Data Source=" & Sheet1.Range("b3") & ";" & "Initial Catalog=" & Sheet1.Range("b2") & ";" & "Integrated Security=SSPI;"
objMyConn.ConnectionString = myConnectionString
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
' If CodePayID = "" Then
'objMyCmd.CommandText = " SELECT SumCurrentValues.YearMonth AS [ماه جاري], SumCurrentValues.EmpID AS [کدپرسنلي], Employees.Name AS نام, Employees.LastName AS [نام خانوادگي], MastPays.EmptypeCode AS [کداستخدام], EmpTypes.Description AS [شرح ]," & _
" SalaryHokmTypes.Description AS [شرح حکم], SumCurrentValues.CodePayID AS [کدپرداخت], CodePays.Description AS شرح, SumCurrentValues.DocVal AS [مبلغ جاري], SumCurrentValues.BackDocVal AS [گذشته جاري]," & _
" SumCurrentValues_1.YearMonth AS [ماه قبل], SumCurrentValues_1.DocVal AS [مبلغ ماه قبل], SumCurrentValues_1.BackDocVal AS [گذشته ماه قبل], SumCurrentValues.DocVal - SumCurrentValues_1.DocVal AS [اختلاف جاري]," & _
" SumCurrentValues.BackDocVal - SumCurrentValues_1.BackDocVal AS [اختلاف گذشته]" & _
" FROM SumCurrentValues INNER JOIN" & _
" CodePays ON SumCurrentValues.RegionCode = CodePays.RegionCode AND SumCurrentValues.CodePayID = CodePays.CodePayID INNER JOIN" & _
" Employees ON SumCurrentValues.EmpID = Employees.EmpID INNER JOIN" & _
" MastPays ON SumCurrentValues.RegionCode = MastPays.RegionCode AND SumCurrentValues.YearMonth = MastPays.YearMonth AND SumCurrentValues.SerialPay = MastPays.SerialPay AND " & _
" SumCurrentValues.EmpID = MastPays.EmpID INNER JOIN" & _
" SalaryHokmTypes ON MastPays.HokmTypeCode = SalaryHokmTypes.SalaryHokmTypeCode INNER JOIN" & _
" EmpTypes ON MastPays.EmptypeCode = EmpTypes.EmpTypeCode LEFT OUTER JOIN" & _
" SumCurrentValues AS SumCurrentValues_1 ON SumCurrentValues.RegionCode = SumCurrentValues_1.RegionCode AND SumCurrentValues.EmpID = SumCurrentValues_1.EmpID AND" & _
" SumCurrentValues.CodePayID = SumCurrentValues_1.CodePayID AND SumCurrentValues_1.YearMonth =" & newmonth & " AND SumCurrentValues_1.SerialPay = 1" & _
" WHERE (SumCurrentValues.YearMonth =" & newmonth & ") AND (SumCurrentValues.SerialPay = 1) AND (MastPays.EmptypeCode IN ( " & Join(EmptypeCode) & " ))"
objMyCmd.CommandType = adCmdText
'Open Recordset'
Set objMyRecordset.Source = objMyCmd
objMyRecordset.Open
For iCols = 0 To objMyRecordset.Fields.Count - 1
Worksheets("Data").Cells(1, iCols + 1).Value = objMyRecordset.Fields(iCols).Name
Next
'Copy Data to Excel'
Worksheets("Data").Range("A2").CopyFromRecordset objMyRecordset
MsgBox "گزارش ساخته شد", vbOKOnly + vbInformation, "پيام"
Sheet2.Activate
End Sub
'Create Variables for the Form'
Dim dbInstance As String
Dim dbDatabase As String
Dim dbLogin As String
Dim dbPassword As String
Dim dbQuery As String
Dim oldmonth As String
Dim newmonth As String
Dim CodePayID As String
Dim EmptypeCode(7) As Integer
Dim EmptypeCode1, EmptypeCode2, EmptypeCode3, EmptypeCode4, EmptypeCode5, EmptypeCode6, EmptypeCode7 As Integer
If checkbox31 = True Then
EmptypeCode(0) = 1
End If
If checkbox33 = True Then
EmptypeCode(1) = 2
End If
If checkbox34 = True Then
EmptypeCode(2) = 3
End If
If checkbox35 = True Then
EmptypeCode(3) = 8
End If
If checkbox36 = True Then
EmptypeCode(4) = 9
End If
If checkbox37 = True Then
EmptypeCode(5) = 18
End If
If checkbox38 = True Then
EmptypeCode(6) = 31
End If
'Attach inputs to the variables
dbInstance = Sheet1.Range("b3").Value
dbDatabase = Sheet1.Range("b2").Value
' dbLogin = LoginTxt.Value
'dbPassword = PasswordTxt.Value
'dbQuery = QueryTxt.Value
oldmonth = Sheet1.Range("g2").Value
newmonth = Sheet1.Range("f2").Value
CodePayID = Sheet1.Range("k2").Value
'Declare variables'
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Dim iCols As Integer
Dim tbl As ListObject
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection'
Dim myConnectionString As String
myConnectionString = "Provider=SQLOLEDB; Data Source=" & dbInstance & ";" & "Initial Catalog=" & dbDatabase & ";" & "Integrated Security=SSPI;"
'sConnString = "Provider=SQLOLEDB;Data Source=" & Sheet1.Range("b3") & ";" & "Initial Catalog=" & Sheet1.Range("b2") & ";" & "Integrated Security=SSPI;"
objMyConn.ConnectionString = myConnectionString
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
' If CodePayID = "" Then
'objMyCmd.CommandText = " SELECT SumCurrentValues.YearMonth AS [ماه جاري], SumCurrentValues.EmpID AS [کدپرسنلي], Employees.Name AS نام, Employees.LastName AS [نام خانوادگي], MastPays.EmptypeCode AS [کداستخدام], EmpTypes.Description AS [شرح ]," & _
" SalaryHokmTypes.Description AS [شرح حکم], SumCurrentValues.CodePayID AS [کدپرداخت], CodePays.Description AS شرح, SumCurrentValues.DocVal AS [مبلغ جاري], SumCurrentValues.BackDocVal AS [گذشته جاري]," & _
" SumCurrentValues_1.YearMonth AS [ماه قبل], SumCurrentValues_1.DocVal AS [مبلغ ماه قبل], SumCurrentValues_1.BackDocVal AS [گذشته ماه قبل], SumCurrentValues.DocVal - SumCurrentValues_1.DocVal AS [اختلاف جاري]," & _
" SumCurrentValues.BackDocVal - SumCurrentValues_1.BackDocVal AS [اختلاف گذشته]" & _
" FROM SumCurrentValues INNER JOIN" & _
" CodePays ON SumCurrentValues.RegionCode = CodePays.RegionCode AND SumCurrentValues.CodePayID = CodePays.CodePayID INNER JOIN" & _
" Employees ON SumCurrentValues.EmpID = Employees.EmpID INNER JOIN" & _
" MastPays ON SumCurrentValues.RegionCode = MastPays.RegionCode AND SumCurrentValues.YearMonth = MastPays.YearMonth AND SumCurrentValues.SerialPay = MastPays.SerialPay AND " & _
" SumCurrentValues.EmpID = MastPays.EmpID INNER JOIN" & _
" SalaryHokmTypes ON MastPays.HokmTypeCode = SalaryHokmTypes.SalaryHokmTypeCode INNER JOIN" & _
" EmpTypes ON MastPays.EmptypeCode = EmpTypes.EmpTypeCode LEFT OUTER JOIN" & _
" SumCurrentValues AS SumCurrentValues_1 ON SumCurrentValues.RegionCode = SumCurrentValues_1.RegionCode AND SumCurrentValues.EmpID = SumCurrentValues_1.EmpID AND" & _
" SumCurrentValues.CodePayID = SumCurrentValues_1.CodePayID AND SumCurrentValues_1.YearMonth =" & newmonth & " AND SumCurrentValues_1.SerialPay = 1" & _
" WHERE (SumCurrentValues.YearMonth =" & newmonth & ") AND (SumCurrentValues.SerialPay = 1) AND (MastPays.EmptypeCode IN ( " & Join(EmptypeCode) & " ))"
objMyCmd.CommandType = adCmdText
'Open Recordset'
Set objMyRecordset.Source = objMyCmd
objMyRecordset.Open
For iCols = 0 To objMyRecordset.Fields.Count - 1
Worksheets("Data").Cells(1, iCols + 1).Value = objMyRecordset.Fields(iCols).Name
Next
'Copy Data to Excel'
Worksheets("Data").Range("A2").CopyFromRecordset objMyRecordset
MsgBox "گزارش ساخته شد", vbOKOnly + vbInformation, "پيام"
Sheet2.Activate
End Sub