I get a Runtime error:
"-2147219913 (80040637) Automation error
"you do not have the required permissions to execute this action"
while trying to upload a file to Test case in QC using VBA.
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx QCurl
QCConnection.Login qcID, qcPWD
QCConnection.Connect qcDomain, qcProject
Dim runName, sCount, TestSetParent, TestSetCount, ActualMessage, attachFactory
nPath = "Test Lab Path"
Set TSetFact = QCConnection.TestSetFactory
Set tsTreeMgr = QCConnection.TestSetTreeManager
Set tsFolder = tsTreeMgr.NodeByPath(nPath)
Set tslist = tsFolder.FindTestSets("Test Set Name")
i = 1
j = 1
Set theTestSet = tslist.Item(i)
For Each testsetfound In tslist
Set tsFolder = testsetfound.TestSetFolder
Set TSTestFactory = testsetfound.TSTestFactory
Set tsTestList = TSTestFactory.NewList("")
k = 1
For Each tstItem In tsTestList
If Not IsEmpty(tstItem) Then
runName = tstItem.RunFactory.UniqueRunName
Set RunF = tstItem.RunFactory
Set theRun = RunF.AddItem(runName)
theRun.Name = runName
theRun.Status = "Passed"
theRun.CopyDesignSteps
theRun.Post
End If
Set runStepF = theRun.StepFactory
Set aTestStepArray = runStepF.NewList("")
step_cnt = aTestStepArray.Count
For j = 1 To step_cnt ' Loop through steps and update in qc
Set runStep = aTestStepArray.Item(j)
step_QC = runStep.Name
runStep.Field("ST_ACTUAL") = runStep.Field("ST_EXPECTED")
runStep.Status = "Passed"
runStep.Post
k = k + 1
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set Inputfolder = fso.GetFolder("FilePath")
Set Infiles = Inputfolder.Files
For Each InFile In Infiles
Set attachFactory = theRun.Attachments
Set attachment = attachFactory.AddItem(Null)
attachment.Filename = "Filename"
attachment.Type = 1
attachment.Post
theRun.Refresh
theRun.Post
Set attachFactory = Nothing
Next
Next
Next
Error happens in the line
attachment.Post
What might be the required permission?
Here is the fix I made to upload attachments to Quality Center.
Set attachFactory = theRun.Attachments
Set attachment = attachFactory.AddItem(Null)
attachment.Filename = "Filename"
attachment.Type = 1
attachment.Save ' <------changed the method to save instead of post for upload in QC
I have 2 lists approvedSuppliers and originalSupplierData
When approved Suppliers gets populated we clone the entry into the originalSupplierData . If they have modified a record but don't save we ask the user if they want to revert the changes . If they want to revert I am trying to replace the entry in approved suppliers with a clone of the original data. My current code for the revert is
Public Sub RevertChanges(SupplierID As Integer)
Dim orignalSupplier As Approved_Supplier = originalSupplierlist.Where(Function(x) x.ID = SupplierID).Single()
Dim modifiedSupplier As Approved_Supplier = ApprovedSuppliers.Where(Function(x) x.ID = SupplierID).Single()
modifiedSupplier = orignalSupplier.Clone
End Sub
The modifiedSupplier gets updated with the original values however the actual item in the list is not updated with the values.
If I modify one of the properties the list gets update. I am not sure what i am doing wrong can anyone point me in the right direction please?
Edit
The code for populating the list from the database is
supplierTableAdapter.Fill(supplierTable)
_approvedSuppliers = New List(Of Approved_Supplier)
originalSupplierlist = New List(Of Approved_Supplier)()
For Each row As ApprovedSuppliersDataset.ApprovedSupplierRow In supplierTable
supplier = New Approved_Supplier()
supplier.supplierID = row.PLSupplierAccountID
supplier.AccountNumber = row.SupplierAccountNumber
supplier.SupplierName = row.SupplierAccountName
supplier.SupplierAddress = CompileAddress(row)
supplier.Phone = CompilePhoneNumber(row)
If row.IsIDNull = False Then
supplier.ID = row.ID
If row.IsAdded_ByNull = False Then
supplier.AddedBy = row.Added_By
End If
If row.IsApprovedNull = False Then
supplier.Approved = row.Approved
End If
If row.IsAuditorNull = False Then
supplier.Auditor = row.Auditor
End If
If row.IsAudit_CommentsNull = False Then
supplier.AuditComments = row.Audit_Comments
End If
If row.IsAudit_DateNull = False Then
supplier.AuditDate = row.Audit_Date
End If
If row.IsDate_AddedNull = False Then
supplier.DateAdded = row.Date_Added
End If
If row.IsNotesNull = False Then
supplier.Notes = row.Notes
End If
If row.IsQuestionnaire_Return_DateNull = False Then
supplier.QuestionnaireReturnDate = row.Questionnaire_Return_Date
End If
If row.IsQuestionnaire_Sent_DateNull = False Then
supplier.QuestionnaireSentDate = row.Questionnaire_Sent_Date
End If
If row.IsQuestionnaire_StatusNull = False Then
supplier.QuestionnaireStatus = row.Questionnaire_Status
End If
If row.IsReplinNull = False Then
supplier.Replin = row.Replin
End If
If row.IsReview_CommentsNull = False Then
supplier.ReviewComment = row.Review_Comments
End If
If row.IsReview_DateNull = False Then
supplier.ReviewDate = row.Review_Date
End If
If row.IsReviewerNull = False Then
supplier.Reviewers = row.Reviewer
End If
If row.IsStakeholder_ContactNull = False Then
supplier.StakeholderContact = row.Stakeholder_Contact
End If
If row.IsStandardsNull = False Then
supplier.Standards = row.Standards
End If
If row.IsStandard_ExpiryNull = False Then
supplier.StandardExpiry = row.Standard_Expiry
End If
If row.IsStatusNull = False Then
supplier.Status = row.Status
End If
If row.IsSupplier_Expiry_DateNull = False Then
supplier.SupplierExpiryDate = row.Supplier_Expiry_Date
End If
If row.IsSupplier_ScopeNull = False Then
supplier.SupplierScope = row.Supplier_Scope
End If
If row.Is_T_CsNull = False Then
supplier.TC = row._T_Cs
End If
End If
supplier.ClearISDirty()
_approvedSuppliers.Add(supplier)
originalSupplierlist.Add(supplier.Clone)
Next
and for the clone we have
Public Function Clone() As Object Implements ICloneable.Clone
Dim cloned As New Approved_Supplier()
cloned.ID = Me.ID
cloned.DateAdded = Me.DateAdded
cloned.Status = Me.Status
cloned.AddedBy = Me.AddedBy
cloned.Approved = Me.Approved
cloned.AuditDate = Me.AuditDate
cloned.Auditor = Me.Auditor
cloned.AuditComments = Me.AuditComments
cloned.QuestionnaireStatus = Me.QuestionnaireStatus
cloned.QuestionnaireSentDate = Me.QuestionnaireSentDate
cloned.QuestionnaireReturnDate = Me.QuestionnaireReturnDate
cloned.ReviewDate = Me.ReviewDate
cloned.Reviewers = Me.Reviewers
cloned.ReviewComment = Me.ReviewComment
cloned.Standards = Me.Standards
cloned.StandardExpiry = Me.StandardExpiry
cloned.SupplierScope = Me.SupplierScope
cloned.Replin = Me.Replin
cloned.TC = Me.TC
cloned.Notes = Me.Notes
cloned.StakeholderContact = Me.StakeholderContact
cloned.SupplierExpiryDate = Me.SupplierExpiryDate
cloned.supplierID = Me.supplierID
cloned.AccountNumber = Me.AccountNumber
cloned.SupplierName = Me.SupplierName
cloned.SupplierAddress = Me.SupplierAddress
cloned.Phone = Me.Phone
cloned.Email = Me.Email
cloned.ClearISDirty()
Return cloned
End Function
You are not replacing in the list by affecting modifiedSupplier.
Try by getting the index of the modifiedSupplier and then replacing the item at the found index by your clone.
Public Sub RevertChanges(SupplierID As Integer)
Dim orignalSupplier As Approved_Supplier = originalSupplierlist.Where(Function(x) x.ID = SupplierID).Single()
Dim modifiedIndex As Integer = ApprovedSuppliers.FindIndex(Function(x) x.ID = SupplierID)
ApprovedSuppliers(modifiedIndex) = orignalSupplier.Clone()
End Sub
maybe is a simple issue but I'm pretty new to EF so:
I have this query:
Dim InvoicesQuery = (From i As Invoice In dbContext.Invoices.AsNoTracking() Where i.InvoiceNumber = -1
Select New InvoicesWithDetails With {
.InvoiceDetails = i.InvoicesDetails,
.InvoiceDetailsUnmerged = i.InvoicesDetailsUnmergeds,
.Examination = Nothing,
.Applicant = Nothing,
.InvoiceNumber = i.InvoiceNumber,
.InvoiceYear = i.InvoiceYear,
.DocCode = i.DocCode,
.CompanyId = i.CompanyId,
.InvoiceDate = i.InvoiceDate,
.NetAmount = i.NetAmount,
.AmountPaid = i.AmountPaid,
.AmountToPay = i.AmountToPay,
.VAT = i.VAT,
.AdditionalTax = i.AdditionalTax,
.Status = i.Status,
.Amount = i.Amount,
.ExaminationId = i.ExaminationId,
.ReceiverName = If(i.OtherReceiverName Is Nothing, i.ReceiverName, i.OtherReceiverName),
.ReceiverAddress = If(i.OtherReceiverAddress Is Nothing, i.ReceiverAddress, i.OtherReceiverAddress),
.ReceiverCity = If(i.OtherReceiverCity Is Nothing, i.ReceiverCity, i.OtherReceiverCity),
.ReceiverTaxCode = If(i.OtherReceiverTaxCode Is Nothing, i.ReceiverTaxCode, i.OtherReceiverTaxCode),
.ReceiverCompanyTaxCode = i.ReceiverCompanyTaxCode,
.ReceiverZipCode = If(i.OtherReceiverZipCode Is Nothing, i.ReceiverZipCode, i.OtherReceiverZipCode),
.IsCreditNote = i.IsCreditNote,
.HasCreditNote = i.HasCreditNote,
.FixedAdditionalAmountOnInvoice = i.FixedAdditionalAmountOnInvoice,
.CashFlowPaymentModeId = If(i.CashFlowPaymentModeId IsNot Nothing, i.CashFlowPaymentModeId.Trim, Nothing),
.AgreementDeductible = i.AgreementDeductible,
.IsPatientInvoiceRecipient = i.IsPatientInvoiceRecipient,
.IsApplicantInvoiceRecipient = i.IsApplicantInvoiceRecipient,
.IsDoctorInvoiceRecipient = i.IsDoctorInvoiceRecipient,
.DoctorId = If(i.DoctorId IsNot Nothing, i.DoctorId, Nothing),
.Doctor = Nothing,
.CreditNoteParentInvoice = i.CreditNoteParentInvoice,
.CreditNoteParentInvoiceYear = i.CreditNoteParentInvoiceYear,
.IsDeferredInvoice = i.IsDeferredInvoice,
.IsExtracted = If(i.IsExtracted IsNot Nothing, i.IsExtracted, False),
.IsExportedToHOST = If(i.IsExportedToHOST IsNot Nothing, i.IsExportedToHOST, False),
.ApplicantId = i.ApplicantId,
.InvoiceHasVAT = i.InvoiceHasVAT,
.VAT_Percentage = i.VAT_Percentage,
.IssuedBy = i.IssuedBy,
.MaskedCounter = i.MaskedCounter,
.DocTypeId = i.DocTypeId,
.OtherReceiverName = i.OtherReceiverName,
.OtherReceiverAddress = i.OtherReceiverAddress,
.OtherReceiverCity = i.OtherReceiverCity,
.OtherReceiverTaxCode = i.OtherReceiverTaxCode,
.OtherReceiverZipCode = i.OtherReceiverZipCode,
.CashFlows = i.CashFlows}).ToList
InvoicesWithDetails is a class that hinerits Invoice; Invoice is a db entity
After this call I loop through the results like this:
For Each i As InvoicesWithDetails In InvoicesQuery.Where(Function(iwd) iwd.CompanyDescription Is Nothing And iwd.CompanyId IsNot Nothing)
i.CompanyDescription = ReturnCompanyDescription(i.CompanyId)
Next
For each cycle in the loop the database is called.
I thought that after the .ToList in the first call I could iterate the results without invoke the database.
What is wrong?
Thanks in advance
Ok, I worked more on that and I tried a different approach:
This is the new query, targeting the Invoice entity:
Dim InvoicesQuery As List(Of Invoice)
InvoicesQuery = (From i As Invoice In dbContext.Invoices.AsNoTracking Where
i.InvoiceDate >= FromDate And i.InvoiceDate <= ToDate).ToList
After that I create a new istance of InvoiceWithDetails and set all the properties like this:
For Each i As Invoice In InvoicesQuery
Dim newInvoiceWithDetails As New InvoicesWithDetails
With newInvoiceWithDetails
.InvoiceDetails = i.InvoicesDetails
.InvoiceDetailsUnmerged = i.InvoicesDetailsUnmergeds
.Examination = Nothing
.Applicant = Nothing
.InvoiceNumber = i.InvoiceNumber
.InvoiceYear = i.InvoiceYear
.DocCode = i.DocCode
.CompanyId = i.CompanyId
.InvoiceDate = i.InvoiceDate
.NetAmount = i.NetAmount
.AmountPaid = i.AmountPaid
.AmountToPay = i.AmountToPay
.VAT = i.VAT
.AdditionalTax = i.AdditionalTax
.Status = i.Status
.Amount = i.Amount
.ExaminationId = i.ExaminationId
.ReceiverName = If(i.OtherReceiverName Is Nothing, i.ReceiverName, i.OtherReceiverName)
.ReceiverAddress = If(i.OtherReceiverAddress Is Nothing, i.ReceiverAddress, i.OtherReceiverAddress)
.ReceiverCity = If(i.OtherReceiverCity Is Nothing, i.ReceiverCity, i.OtherReceiverCity)
.ReceiverTaxCode = If(i.OtherReceiverTaxCode Is Nothing, i.ReceiverTaxCode, i.OtherReceiverTaxCode)
.ReceiverCompanyTaxCode = i.ReceiverCompanyTaxCode
.ReceiverZipCode = If(i.OtherReceiverZipCode Is Nothing, i.ReceiverZipCode, i.OtherReceiverZipCode)
.IsCreditNote = i.IsCreditNote
.HasCreditNote = i.HasCreditNote
.FixedAdditionalAmountOnInvoice = i.FixedAdditionalAmountOnInvoice
.CashFlowPaymentModeId = If(i.CashFlowPaymentModeId IsNot Nothing, i.CashFlowPaymentModeId.Trim, Nothing)
.AgreementDeductible = i.AgreementDeductible
.IsPatientInvoiceRecipient = i.IsPatientInvoiceRecipient
.IsApplicantInvoiceRecipient = i.IsApplicantInvoiceRecipient
.IsDoctorInvoiceRecipient = i.IsDoctorInvoiceRecipient
.DoctorId = If(i.DoctorId IsNot Nothing, i.DoctorId, Nothing)
.Doctor = Nothing
.CreditNoteParentInvoice = i.CreditNoteParentInvoice
.CreditNoteParentInvoiceYear = i.CreditNoteParentInvoiceYear
.IsDeferredInvoice = i.IsDeferredInvoice
.IsExtracted = If(i.IsExtracted IsNot Nothing, i.IsExtracted, False)
.IsExportedToHOST = If(i.IsExportedToHOST IsNot Nothing, i.IsExportedToHOST, False)
.ApplicantId = i.ApplicantId
.InvoiceHasVAT = i.InvoiceHasVAT
.VAT_Percentage = i.VAT_Percentage
.IssuedBy = i.IssuedBy
.MaskedCounter = i.MaskedCounter
.DocTypeId = i.DocTypeId
.OtherReceiverName = i.OtherReceiverName
.OtherReceiverAddress = i.OtherReceiverAddress
.OtherReceiverCity = i.OtherReceiverCity
.OtherReceiverTaxCode = i.OtherReceiverTaxCode
.OtherReceiverZipCode = i.OtherReceiverZipCode
.CashFlows = i.CashFlows
End With
FinalList.Add(newInvoiceWithDetails)
For each cycle and each property value, the database is invoked
Again, what is wrong?
Keep getting an automation error when my userform uses the below code when it initializes. I dont get an error when i take it out. The userform is being called from a shape using a module. the text from the userform is stored under a sheet called "Compliance". My userform is also called compliance. Here is my code below, any help would be much appreciated:
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Set ws = Sheets("compliance")
On Error Resume Next
With page1
employee1.Value = ws.Range("B2")
employee2.Value = ws.Range("B3")
employee3.Value = ws.Range("B4")
employee4.Value = ws.Range("B5")
employee5.Value = ws.Range("B5")
employee6.Value = ws.Range("B6")
'//// setting ops grade
grade1.Value = ws.Range("D2")
grade2.Value = ws.Range("D3")
grade3.Value = ws.Range("D4")
grade4.Value = ws.Range("D5")
grade5.Value = ws.Range("D6")
grade6.Value = ws.Range("D7")
'//// setting employee compliance recap
recap1.Value = ws.Range("F2")
recap2.Value = ws.Range("F3")
recap3.Value = ws.Range("F4")
recap4.Value = ws.Range("F5")
recap5.Value = ws.Range("F6")
recap6.Value = ws.Range("F7")
'////////////////////////////////////////// febraury
'//// setting employees interviewed
With page2
febemp1.Value = ws.Range("B14")
febemp2.Value = ws.Range("B15")
febemp3.Value = ws.Range("B16")
febemp4.Value = ws.Range("B17")
febemp5.Value = ws.Range("B18")
febemp6.Value = ws.Range("B19")
febgrd1.Value = ws.Range("D14")
febgrd2.Value = ws.Range("D15")
febgrd3.Value = ws.Range("D16")
febgrd4.Value = ws.Range("D17")
febgrd5.Value = ws.Range("D18")
febgrd6.Value = ws.Range("D19")
febrecap1.Value = ws.Range("F14")
febrecap2.Value = ws.Range("F15")
febrecap3.Value = ws.Range("F16")
febrecap4.Value = ws.Range("F17")
febrecap5.Value = ws.Range("F18")
febrecap6.Value = ws.Range("F19")
With page3
marchemp1.Value = ws.Range("B26")
marchemp2.Value = ws.Range("B27")
marchemp3.Value = ws.Range("B28")
marchemp4.Value = ws.Range("B29")
marchemp5.Value = ws.Range("B30")
marchemp6.Value = ws.Range("B31")
marchgrd1.Value = ws.Range("D26")
marchgrd2.Value = ws.Range("D27")
marchgrd3.Value = ws.Range("D28")
marchgrd4.Value = ws.Range("D29")
marchgrd5.Value = ws.Range("D30")
marchgrd6.Value = ws.Range("D31")
marchrecap1.Value = ws.Range("F26")
marchrecap2.Value = ws.Range("F27")
marchrecap3.Value = ws.Range("F28")
marchrecap4.Value = ws.Range("F29")
marchrecap5.Value = ws.Range("F30")
marchrecap6.Value = ws.Range("F31")
With page4
apremp1.Value = ws.Range("B38")
apremp2.Value = ws.Range("B39")
apremp3.Value = ws.Range("B40")
apremp4.Value = ws.Range("B41")
apremp5.Value = ws.Range("B42")
apremp6.Value = ws.Range("B43")
aprgrd1.Value = ws.Range("D38")
aprgrd2.Value = ws.Range("D39")
aprgrd3.Value = ws.Range("D40")
aprgrd4.Value = ws.Range("D41")
aprgrd5.Value = ws.Range("D42")
aprgrd6.Value = ws.Range("D43")
aprrecap1.Value = ws.Range("F38")
aprrecap2.Value = ws.Range("F39")
aprrecap3.Value = ws.Range("F40")
aprrecap4.Value = ws.Range("F41")
aprrecap5.Value = ws.Range("F42")
aprrecap6.Value = ws.Range("F43")
With page5
mayemp1.Value = ws.Range("B50")
mayemp2.Value = ws.Range("B51")
mayemp3.Value = ws.Range("B52")
mayemp4.Value = ws.Range("B53")
mayemp5.Value = ws.Range("B54")
mayemp6.Value = ws.Range("B55")
maygrd1.Value = ws.Range("D50")
maygrd2.Value = ws.Range("D51")
maygrd3.Value = ws.Range("D52")
maygrd4.Value = ws.Range("D53")
maygrd5.Value = ws.Range("D54")
maygrd6.Value = ws.Range("D55")
mayrecap1.Value = ws.Range("F50")
mayrecap2.Value = ws.Range("F51")
mayrecap3.Value = ws.Range("F52")
mayrecap4.Value = ws.Range("F53")
mayrecap5.Value = ws.Range("F54")
mayrecap6.Value = ws.Range("F55")
With page6
junemp1.Value = ws.Range("B62")
junemp2.Value = ws.Range("B63")
junemp3.Value = ws.Range("B64")
junemp4.Value = ws.Range("B65")
junemp5.Value = ws.Range("B66")
junemp6.Value = ws.Range("B67")
jungrd1.Value = ws.Range("D62")
jungrd2.Value = ws.Range("D63")
jungrd3.Value = ws.Range("D64")
jungrd4.Value = ws.Range("D65")
jungrd5.Value = ws.Range("D66")
jungrd6.Value = ws.Range("D67")
junrecap1.Value = ws.Range("F62")
junrecap2.Value = ws.Range("F63")
junrecap3.Value = ws.Range("F64")
junrecap4.Value = ws.Range("F65")
junrecap5.Value = ws.Range("F66")
junrecap6.Value = ws.Range("F67")
With page7
julemp1.Value = ws.Range("B74")
julemp2.Value = ws.Range("B75")
julemp3.Value = ws.Range("B76")
julemp4.Value = ws.Range("B77")
julemp5.Value = ws.Range("B78")
julemp6.Value = ws.Range("B79")
julgrd1.Value = ws.Range("D74")
julgrd2.Value = ws.Range("D75")
julgrd3.Value = ws.Range("D76")
julgrd4.Value = ws.Range("D77")
julgrd5.Value = ws.Range("D78")
julgrd6.Value = ws.Range("D79")
julrecap1.Value = ws.Range("F74")
julrecap2.Value = ws.Range("F75")
julrecap3.Value = ws.Range("F76")
julrecap4.Value = ws.Range("F77")
julrecap5.Value = ws.Range("F78")
julrecap6.Value = ws.Range("F79")
With page8
augemp1.Value = ws.Range("B86")
augemp2.Value = ws.Range("B87")
augemp3.Value = ws.Range("B88")
augemp4.Value = ws.Range("B89")
augemp5.Value = ws.Range("B90")
augemp6.Value = ws.Range("B91")
auggrd1.Value = ws.Range("D86")
auggrd2.Value = ws.Range("D87")
auggrd3.Value = ws.Range("D88")
auggrd4.Value = ws.Range("D89")
auggrd5.Value = ws.Range("D90")
auggrd6.Value = ws.Range("D91")
augrecap1.Value = ws.Range("F86")
augrecap2.Value = ws.Range("F87")
augrecap3.Value = ws.Range("F88")
augrecap4.Value = ws.Range("F89")
augrecap5.Value = ws.Range("F90")
augrecap6.Value = ws.Range("F91")
With page9
sepemp1.Value = ws.Range("B98")
sepemp2.Value = ws.Range("B99")
sepemp3.Value = ws.Range("B100")
sepemp4.Value = ws.Range("B101")
sepemp5.Value = ws.Range("B102")
sepemp6.Value = ws.Range("B103")
sepgrd1.Value = ws.Range("D98")
sepgrd2.Value = ws.Range("D99")
sepgrd3.Value = ws.Range("D100")
sepgrd4.Value = ws.Range("D101")
sepgrd5.Value = ws.Range("D102")
sepgrd6.Value = ws.Range("D103")
seprecap1.Value = ws.Range("F98")
seprecap2.Value = ws.Range("F99")
seprecap3.Value = ws.Range("F100")
seprecap4.Value = ws.Range("F101")
seprecap5.Value = ws.Range("F102")
seprecap6.Value = ws.Range("F103")
With page10
octemp1.Value = ws.Range("B110")
octemp2.Value = ws.Range("B111")
octemp3.Value = ws.Range("B112")
octemp4.Value = ws.Range("B113")
octemp5.Value = ws.Range("B114")
octemp6.Value = ws.Range("B115")
octgrd1.Value = ws.Range("D110")
octgrd2.Value = ws.Range("D111")
octgrd3.Value = ws.Range("D112")
octgrd4.Value = ws.Range("D113")
octgrd5.Value = ws.Range("D114")
octgrd6.Value = ws.Range("D115")
octrecap1.Value = ws.Range("F110")
octrecap2.Value = ws.Range("F111")
octrecap3.Value = ws.Range("F112")
octrecap4.Value = ws.Range("F113")
octrecap5.Value = ws.Range("F114")
octrecap6.Value = ws.Range("F115")
With page11
novemp1.Value = ws.Range("B122")
novemp2.Value = ws.Range("B123")
novemp3.Value = ws.Range("B124")
novemp4.Value = ws.Range("B125")
novemp5.Value = ws.Range("B126")
novemp6.Value = ws.Range("B127")
novgrd1.Value = ws.Range("D122")
novgrd2.Value = ws.Range("D123")
novgrd3.Value = ws.Range("D124")
novgrd4.Value = ws.Range("D125")
novgrd5.Value = ws.Range("D126")
novgrd6.Value = ws.Range("D127")
novrecap1.Value = ws.Range("F122")
novrecap2.Value = ws.Range("F123")
novrecap3.Value = ws.Range("F124")
novrecap4.Value = ws.Range("F125")
novrecap5.Value = ws.Range("F126")
novrecap6.Value = ws.Range("F127")
With page12
decemp1.Value = ws.Range("B134")
decemp2.Value = ws.Range("B135")
decemp3.Value = ws.Range("B136")
decemp4.Value = ws.Range("B137")
decemp5.Value = ws.Range("B138")
decemp6.Value = ws.Range("B139")
decgrd1.Value = ws.Range("D134")
decgrd2.Value = ws.Range("D135")
decgrd3.Value = ws.Range("D136")
decgrd4.Value = ws.Range("D137")
decgrd5.Value = ws.Range("D138")
decgrd6.Value = ws.Range("D139")
decrecap1.Value = ws.Range("F134")
decrecap2.Value = ws.Range("F135")
decrecap3.Value = ws.Range("F136")
decrecap4.Value = ws.Range("F137")
decrecap5.Value = ws.Range("F138")
decrecap6.Value = ws.Range("F139")
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End Sub
Untested - too many controls to make...
You'd need to harmonize your control naming a bit, but something like this should work:
Private Sub UserForm_Initialize()
Dim ws As Worksheet, mNum As Long, months, i As Long, m
Dim c As Range
Set ws = Sheets("compliance")
Set c = ws.Range("B1")
months = Array("jan", "feb", "mar", "apr", "may", "jun", _
"jul", "aug", "sep", "oct", "nov", "dec")
For mNum = 1 To 12
m = months(m - 1)
With Me.MultiPage1.Pages("page" & mNum)
For i = 1 To 6
.Controls(m & "emp" & i).Value = c.Offset(i, 0).Value
.Controls(m & "grd" & i).Value = c.Offset(i, 2).Value
.Controls(m & "recap" & i).Value = c.Offset(i, 4).Value
Next i
End With
Set c = c.Offset(12, 0)
Next mNum
End Sub
For the first time when I run my window application it will successfully run, but when I change the database column and binding then it gives me an error that specific data column is not there in database; also I am make null chart datasource but it gives an error. Please help.
Dim ctrArr As Integer
Dim serCnt As Integer
Dim series1 As New Series
Dim seriesFound As Boolean = False
For serCnt = 0 To ctrChart.Series.Count - 1
ctrChart.Series(0).ArgumentDataMember = ""
ctrChart.Series(0).ValueDataMembers(0) = ""
ctrChart.Series(0).Visible = False
Next
For ctrArr = 0 To gStrYAxisParamArray.Length - 1 'deptname'
For serCnt = 0 To ctrChart.Series.Count - 1
If UCase(Trim(gStrYAxisParamArray(ctrArr))) = UCase(ctrChart.Series(serCnt).Name.ToString) Then
ctrChart.Series(serCnt).ArgumentDataMember = ""
ctrChart.Series(serCnt).ValueDataMembers(0) = ""
ctrChart.Series(serCnt).Visible = True
ctrChart.Series(serCnt).ArgumentDataMember = gxAxis
ctrChart.Series(serCnt).ValueDataMembers.Item(0) = Trim(gStrYAxisParamArray(ctrArr))
seriesFound = True
Exit For
End If
Next
If seriesFound = False Then
series1 = New Series(Trim(gStrYAxisParamArray(ctrArr)).ToString, ViewType.Bar)
'ctrChart.Series.AddRange(New Series() {series1, series2})
ctrChart.Series.Add(series1)
series1.ArgumentDataMember = ""
series1.ValueDataMembers(0) = ""
series1.Visible = True
series1.ArgumentDataMember = gxAxis
series1.Label.Border.Visible = False
series1.ValueDataMembers(0) = Trim(gStrYAxisParamArray(ctrArr))
series1.LegendText = Trim(gStrYAxisParamArray(ctrArr).ToString)
End If
seriesFound = False
Next
cmbSeries.Items.Clear()
For ctrArr = 0 To ChrtStockDept.Series.Count - 1
With cmbSeries.Items
cmbSeries.Items.Add(ChrtStockDept.Series(ctrArr).Name.ToString)
End With
Next