ماکرو شرطی از بین رفتن اکسل

**azizi.mohsen** · 2016/05/11, 02:29

سلام دوستان عزیز
من هم همین مشکل دارم
لطفا جواب بدید
میخوام ماکرویی ایجاد کنم که مقدار دو سلول در یک شیت رو ( مثلا sheet 1 )مورد بررسی قرار بده
اگه دو مقدار مساوی بود به شیت دیگه ( مثلا sheet 2 ) هدایت بشه در غیر این صورت پیغام خطا بده
ممنون میشم اساتید عزیز جواب بدن

**amir_ts** · 2016/05/11, 10:43

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

کد:

[LEFT]

Sub test()
If Range("a1").Value = Range("b1").Value Then
Sheet2.Activate
Else
MsgBox "The numbers are not equal.", 48


End If
End Sub[/LEFT]

**amir_ts** · 2016/05/11, 10:56

نوشته اصلی توسط saeed_goli144

سلام
یه ماکرو میخوام که اگر توی شیت main سلولهای cell k10=cell M10 بود هیچی اگر مساوی نبودن فایل اکسل اکسپایر بشه
ممنون میشم راهنماییم کنین

کد زیر رو امتحان کنید.

کد:

[LEFT]Sub test()


     If Range("m10").Value <> Range("k10").Value Then
      MsgBox "This workbook is Expired and will now close !!!"
       ActiveWorkbook.Close
       End If
End Sub[/LEFT]

**azizi.mohsen** · 2016/05/11, 16:20

از دوست عزیزم amir_ts کمال تشکر رو دارم
یه سوال دیگه داشتم هم داشتم
فرمول یا دستوری هست که بشه سریال هارد و cpu رو تو دوتا سلول مجزا وارد کرد؟
اگه هست ممنون می شم فرمول یا دستور مورد نظر که باید تو هر سلول وارد کرد رو بگیم
بازم تشکر میکنم از همه دوستان عزیز

**amir_ts** · 2016/05/11, 20:07

فرمول یا دستوری هست که بشه سریال هارد و cpu رو تو دوتا سلول مجزا وارد کرد؟

با سلام
دوست عزیز سوال شما با موضوع اصلی مطرح شده همخوانی نداره لطفا" از مدیران درخواست جابه جایی موضوع رو پیگیری کنید تا هم به قوانین انجمن احترام بزاریم و هم کمکی کنیم برای راحت تر پیدا کردن موضوع مطرح شده برای دیگران عزیزانی که ممکنه همین سوال براشون پیش بیاد.

کد های زیر رو امتحان کنید.

کد:

[LEFT]
Sub ProcessorInfo()
    Dim cimv2, PInfo, PItem As Variant
    Dim PubStrComputer As String
    PubStrComputer = "."
    Set cimv2 = GetObject("winmgmts:\\" & PubStrComputer & "\root\cimv2")
    Set PInfo = cimv2.ExecQuery("Select * From Win32_Processor")
    For Each PItem In PInfo
               Range("a1").Value = PItem.ProcessorId
               MsgBox ("Processor: " & PItem.Name & vbCrLf & "Id: " & PItem.ProcessorId)
    Next PItem
End Sub

[/LEFT]

کد:

[LEFT]

Sub HDSerialNumber()
    Dim fsObj   As Object
    Dim drv     As Object
    Dim HDSerialNum As Variant
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives("C")

    HDSerialNum = Left(Hex(drv.SerialNumber), 4) _
        & "-" & Right(Hex(drv.SerialNumber), 4)
        
               Range("b1").Value = HDSerialNum
               MsgBox ("HDSerialNumber: " & HDSerialNum)

 End Sub


[/LEFT]

فایل های پیوست شده