انتقال اطلاعات از دو فرم به یک دیتابیس در امتداد یکدیگر

[exceliran]

سلام خدمت اساتید عزیز
در فایل زیر 3 شیت داریم که 2 شیت درواقع فرم هستند و یک شیت دیتابیس. ( ابتدا باید فرم 1 تکمیل بشه و سپس فرم 2 ) . میخواستم وقتی اطلاعات در فرم 1 پر میشه و به دیتابیس انتقال میدیم با کد ویژوال، هرزمان فرم 2 پر شد اطلاعات باتوجه به آیتم منحصر بفرد (کدپرسنلی ) در امتداد همان اطلاعات قرار بگیره.
مورد بعدی این که میخواستم در شیت استارت وقتی اپراتور روی فرم 1 کلیک میکنه قبل اینکه وارد فرم 1 بشه کد درخواست کنه و اگه اپراتور اون کد رو درست وارد کرد وارد فرم 1 بشه.
ممنووون بابت پاسخگویی دوستان عزیز

[Ali Parsaei]

سلام،
لينک فرم 1 را در صفحه استارت به اين ماکرو ربط دهيد:

Sub Macro1()
Dim C As String
C = InputBox("کد دسترسي را وارد کنيد")
If C = "123" Then
Sheet3.Activate
Else
MsgBox "کد غلط است", vbOKOnly
End If
End Sub 

و دگمه تاييد فرم دو را به چنين ماکرويي لينک دهيد:

Sub Macro2()
Dim C As Range
For Each C In Sheet4.Range("F9:F500")
Sheet2.Select
Sheet2.Range("A2:A500").Find(C, , xlValues, xlWhole).Select
Selection.Offset(0, 5).Value = C.Offset(0, 1).Value
Selection.Offset(0, 6).Value = C.Offset(0, 2).Value
Next
End Sub 

البته براي کد براي 500 سطر نوشته شده

[exceliran]

سلام،
لينک فرم 1 را در صفحه استارت به اين ماکرو ربط دهيد:

Sub Macro1()
Dim C As String
C = InputBox("کد دسترسي را وارد کنيد")
If C = "123" Then
Sheet3.Activate
Else
MsgBox "کد غلط است", vbOKOnly
End If
End Sub 

و دگمه تاييد فرم دو را به چنين ماکرويي لينک دهيد:

Sub Macro2()
Dim C As Range
For Each C In Sheet4.Range("F9:F500")
Sheet2.Select
Sheet2.Range("A2:A500").Find(C, , xlValues, xlWhole).Select
Selection.Offset(0, 5).Value = C.Offset(0, 1).Value
Selection.Offset(0, 6).Value = C.Offset(0, 2).Value
Next
End Sub 

البته براي کد براي 500 سطر نوشته شده

ممنون از پاسخگویی . چطوری میشه بجای اینکه از offset استفاده کنیم، از تابع match استفاده کنیم تا داینامیک تر بشه؟

[exceliran]

چطوری میشه هنگامی که پسورد زده میشه به صورت * نمایش داده بشه؟ ( یعنی اپراتور که میزنه 123 ما *** مشاهده کنیم )

[Ali Parsaei]

براي inputbox بلد نيستم چطور اين کار را مي شود کرد،
ولي مي شود به جاي inputbox از يک يوزر فرم استفاده کرد و در آن يوزر فرم يک textbox براي ورود رمز قرار داد و کد را بر مبناي آن نوشت.
در آن صورت مي توانيد در جلوي خصوصيت passwordchar براي تکست بکس عبارت "*" بنويسيد و در آن صورت هر چه که در تکست بکس تايپ کنيد به صورت ستاره مشاهده خواهد شد.

[Javid Mokhtari]

ممنون از پاسخگویی . چطوری میشه بجای اینکه از offset استفاده کنیم، از تابع match استفاده کنیم تا داینامیک تر بشه؟

با سلام.

دوست عزیز نمیدونم منظورتان از داینامیک تر چی هستش.ولی همین کدی که دوست عزیزمان آقای پارسا زحمتش رو کشیدن خودش داینامیک هستش.

بله، میتوان از Match یا Vlookup و یا توابع مشابه استفاده کرد ولی با این کدها من نیازی نمیبینم از این تابع استفاده کنم چون یکم گیج کننده میشه.

به هرحال میتونید کد رو به شکل زیر بنویسید تا به قول شما داینامیکتر بشه...

On Error Resume Next
Dim C As Range
For Each C In Sheet4.Range("F9", Range("F100000").End(xlUp).Address)
Sheet2.Select
Sheet2.Range("A2", Range("a100000").End(xlUp).Address).Find(C, , xlValues, xlWhole).Select
Selection.Offset(0, 5).Value = C.Offset(0, 1).Value
Selection.Offset(0, 6).Value = C.Offset(0, 2).Value
Next 

باز اگر منظورتان را خوب متوجه نشدم بیشتر توضیح بدهید که منظورتان دقیقا چیست...؟