کمک برا کلید حذف

Collapse
X
Collapse
 
  • صفحه از 1
  • زمان
  • نمایش
حذف همه
new posts
قبلی template بعدی
  • میثم مقدم نیا

    • 2017/03/23
    • 558
    • 41.00
    #1

    پرسش کمک برا کلید حذف

    سلام
    دوستان تو فایل پیوست من در ایجاد کلید حذف با یک مشکل مواجه شدم
    اول از این که یکی از ردیف هارا حذف میکنم فرمول های زیری اون با پیغام خطا روبرو میشه
    دوم اینکه وقتی من داخل یوزرفرم در قسمت ردیف شماره را وارد کردم بتونم اون ردیف را حذف کنم ولی در کد من سلکت نمیشه
    فایل های پیوست شده
    [HR][SIZE=5][COLOR="#0000FF"][FONT=Times New Roman][B] در سرزمینی کہ نتوان مردانہ زیست ، مردانہ مردن بهتر از این زندگیست [/B][/FONT][/COLOR][/SIZE][/HR]
    برچسب ها: هیچ‌کدام
    • M_ExceL

      • 2018/04/23
      • 677
      #2
      نوشته اصلی توسط mmn1000
      سلام
      دوستان تو فایل پیوست من در ایجاد کلید حذف با یک مشکل مواجه شدم
      اول از این که یکی از ردیف هارا حذف میکنم فرمول های زیری اون با پیغام خطا روبرو میشه
      دوم اینکه وقتی من داخل یوزرفرم در قسمت ردیف شماره را وارد کردم بتونم اون ردیف را حذف کنم ولی در کد من سلکت نمیشه
      سلام،
      برای کلید حذف، کد زیر رو استفاده کنید :
      کد:
      Private Sub Delete_Click()

If TextBox00.Text = "" Then MsgBox ChrW(1607) & ChrW(1740) & ChrW(1670) & ChrW(32) _
& ChrW(1575) & ChrW(1591) & ChrW(1604) & ChrW(1575) & ChrW(1593) & ChrW(1575) & _
ChrW(1578) & ChrW(1740) & ChrW(32) & ChrW(1576) & ChrW(1585) & ChrW(1575) & _
ChrW(1740) & ChrW(32) & ChrW(1581) & ChrW(1584) & ChrW(1601) & ChrW(32) & _
ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1606) & _
ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583), vbMsgBoxRight, ChrW(1581) & _
ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1575) & ChrW(1591) & ChrW(1604) & _
ChrW(1575) & ChrW(1593) & ChrW(1575) & ChrW(1578): Exit Sub
r = MsgBox(ChrW(1570) & ChrW(1740) & ChrW(1575) & ChrW(32) & ChrW(1605) & ChrW(1740) _
& ChrW(32) & ChrW(1582) & ChrW(1608) & ChrW(1575) & ChrW(1607) & ChrW(1740) & ChrW(1583) _
& ChrW(32) & ChrW(1575) & ChrW(1740) & ChrW(1606) & ChrW(32) & ChrW(1585) & ChrW(1583) _
& ChrW(1740) & ChrW(1601) & ChrW(32) & ChrW(1585) & ChrW(1575) & ChrW(32) & ChrW(1581) _
& ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1705) & ChrW(1606) & ChrW(1740) & ChrW(1583) _
& ChrW(1567), vbYesNo, ChrW(1581) & ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1575) & _
ChrW(1591) & ChrW(1604) & ChrW(1575) & ChrW(1593) & ChrW(1575) & ChrW(1578))
If r <> 6 Then
Exit Sub
Else
   For i = 2 To Cells(Rows.Count, 1).End(3).Row
   If TextBox00.Text = Cells(i, 1) Then
   Cells(i, 1).EntireRow.Delete
   Cells(i, 5).Formula = "=sum(c" & i & "+e" & i - 1 & ")-" & "sum(d" & i & ")"
   End If
   Next
End If

End Sub
      [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
      [/CENTER]

        کامنت

        • میثم مقدم نیا

          • 2017/03/23
          • 558
          • 41.00
          #3
          نوشته اصلی توسط M_ExceL
          سلام،
          برای کلید حذف، کد زیر رو استفاده کنید :
          کد:
          Private Sub Delete_Click()

If TextBox00.Text = "" Then MsgBox ChrW(1607) & ChrW(1740) & ChrW(1670) & ChrW(32) _
& ChrW(1575) & ChrW(1591) & ChrW(1604) & ChrW(1575) & ChrW(1593) & ChrW(1575) & _
ChrW(1578) & ChrW(1740) & ChrW(32) & ChrW(1576) & ChrW(1585) & ChrW(1575) & _
ChrW(1740) & ChrW(32) & ChrW(1581) & ChrW(1584) & ChrW(1601) & ChrW(32) & _
ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1606) & _
ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583), vbMsgBoxRight, ChrW(1581) & _
ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1575) & ChrW(1591) & ChrW(1604) & _
ChrW(1575) & ChrW(1593) & ChrW(1575) & ChrW(1578): Exit Sub
r = MsgBox(ChrW(1570) & ChrW(1740) & ChrW(1575) & ChrW(32) & ChrW(1605) & ChrW(1740) _
& ChrW(32) & ChrW(1582) & ChrW(1608) & ChrW(1575) & ChrW(1607) & ChrW(1740) & ChrW(1583) _
& ChrW(32) & ChrW(1575) & ChrW(1740) & ChrW(1606) & ChrW(32) & ChrW(1585) & ChrW(1583) _
& ChrW(1740) & ChrW(1601) & ChrW(32) & ChrW(1585) & ChrW(1575) & ChrW(32) & ChrW(1581) _
& ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1705) & ChrW(1606) & ChrW(1740) & ChrW(1583) _
& ChrW(1567), vbYesNo, ChrW(1581) & ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1575) & _
ChrW(1591) & ChrW(1604) & ChrW(1575) & ChrW(1593) & ChrW(1575) & ChrW(1578))
If r <> 6 Then
Exit Sub
Else
   For i = 2 To Cells(Rows.Count, 1).End(3).Row
   If TextBox00.Text = Cells(i, 1) Then
   Cells(i, 1).EntireRow.Delete
   Cells(i, 5).Formula = "=sum(c" & i & "+e" & i - 1 & ")-" & "sum(d" & i & ")"
   End If
   Next
End If

End Sub
          ممنون از پاسخ شما استاد عزیزم
          در این کد یه اشکال کوچکی است و اونم اینکه وقتی آخرین ردیف را حذف میکنیم کد درست عمل نمیکند و ردیف آخر به طور کامل حذف نمیشود
          ممنون میشوم اگه کد را دوباره برسی کنید
          [HR][SIZE=5][COLOR="#0000FF"][FONT=Times New Roman][B] در سرزمینی کہ نتوان مردانہ زیست ، مردانہ مردن بهتر از این زندگیست [/B][/FONT][/COLOR][/SIZE][/HR]

            کامنت

            • M_ExceL

              • 2018/04/23
              • 677
              #4
              نوشته اصلی توسط mmn1000
              ممنون از پاسخ شما استاد عزیزم
              در این کد یه اشکال کوچکی است و اونم اینکه وقتی آخرین ردیف را حذف میکنیم کد درست عمل نمیکند و ردیف آخر به طور کامل حذف نمیشود
              ممنون میشوم اگه کد را دوباره برسی کنید
              سلام،
              خواهش میکنم،
              چک کنید.
              کد:
              Private Sub Delete_Click()
lstr = Cells(Rows.Count, 1).End(3).Row
If TextBox00.Text = "" Then MsgBox ChrW(1607) & ChrW(1740) & ChrW(1670) & ChrW(32) _
& ChrW(1575) & ChrW(1591) & ChrW(1604) & ChrW(1575) & ChrW(1593) & ChrW(1575) & _
ChrW(1578) & ChrW(1740) & ChrW(32) & ChrW(1576) & ChrW(1585) & ChrW(1575) & _
ChrW(1740) & ChrW(32) & ChrW(1581) & ChrW(1584) & ChrW(1601) & ChrW(32) & _
ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1606) & _
ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583), vbMsgBoxRight, ChrW(1581) & _
ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1575) & ChrW(1591) & ChrW(1604) & _
ChrW(1575) & ChrW(1593) & ChrW(1575) & ChrW(1578): Exit Sub
r = MsgBox(ChrW(1570) & ChrW(1740) & ChrW(1575) & ChrW(32) & ChrW(1605) & ChrW(1740) _
& ChrW(32) & ChrW(1582) & ChrW(1608) & ChrW(1575) & ChrW(1607) & ChrW(1740) & ChrW(1583) _
& ChrW(32) & ChrW(1575) & ChrW(1740) & ChrW(1606) & ChrW(32) & ChrW(1585) & ChrW(1583) _
& ChrW(1740) & ChrW(1601) & ChrW(32) & ChrW(1585) & ChrW(1575) & ChrW(32) & ChrW(1581) _
& ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1705) & ChrW(1606) & ChrW(1740) & ChrW(1583) _
& ChrW(1567), vbYesNo, ChrW(1581) & ChrW(1584) & ChrW(1601) & ChrW(32) & ChrW(1575) & _
ChrW(1591) & ChrW(1604) & ChrW(1575) & ChrW(1593) & ChrW(1575) & ChrW(1578))
If r <> 6 Then
Exit Sub
Else
   For i = 2 To lstr
   If TextBox00.Text = Cells(i, 1) Then p = Cells(i, 1).Row
   If p = lstr Then
   Cells(p, 1).EntireRow.Delete
   Exit Sub
   ElseIf TextBox00.Text = Cells(i, 1) Then
   Cells(i, 1).EntireRow.Delete
   Cells(i, 5).Formula = "=sum(c" & i & "+e" & i - 1 & ")-" & "sum(d" & i & ")"
   Exit Sub
   End If
   Next
End If

End Sub
              [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
              [/CENTER]

                کامنت

                قبلی template بعدی
                چند لحظه..