このコードを実行すると、Excelがフリーズし続ける

Question

コマンドボタン（ActiveX）から関数を実行していますが、実行すると、毎回フリーズします。なぜ誰が見るのですか？

コードは空の書式設定されたシートから範囲をコピーし、コマンドボタンが配置されているワークシートに挿入します（新しい月を挿入する）。

Function nyMndFunction(navnArk As String) 
Dim gammelMnd As String 
Dim nyMnd As String 
Dim wstEnt As Worksheet 
Dim wstMal As Worksheet 
Dim insertRange As Range 

Set wstMal = Worksheets("Mal") 
Set wstEnt = Worksheets(navnArk) 

wstMal.Range(wstMal.Cells(1, 1), wstMal.Cells(41, 11)).Copy 

gammelMnd = wstEnt.Cells(4, 2).Value 

Select Case gammelMnd 
    Case "JANUAR" 
     nyMnd = "FEBRUAR" 
    Case "FEBRUAR" 
     nyMnd = "MARS" 
    Case "MARS" 
     nyMnd = "APRIL" 
    Case "APRIL" 
     nyMnd = "MAI" 
    Case "MAI" 
     nyMnd = "JUNI" 
    Case "JUNI" 
     nyMnd = "JULI" 
    Case "JULI" 
     nyMnd = "AUGUST" 
    Case "AUGUST" 
     nyMnd = "SEPTEMBER" 
    Case "SEPTEMBER" 
     nyMnd = "OKTOBER" 
    Case "OKTOBER" 
     nyMnd = "NOVEMBER" 
    Case "NOVEMBER" 
     nyMnd = "DESEMBER" 
    Case "DESEMBER" 
     nyMnd = "JANUAR" 
End Select 

wstEnt.Range("B4").Insert Shift:=xlDown 
wstEnt.Cells(4, 2).Value = nyMnd 
wstEnt.Cells(3, 3).Select 
End Function 

、その後、私はそれがCutCopyModeモードのためだと信じてい

Private Sub cmd_NyMndBravida_Click() 
    Dim navnArk As String 

    navnArk = ActiveSheet.Name 
    nyMndFunction (navnArk) 

End Sub 

Answer 1

8つの異なるワークシートにこれでそれを呼び出すので、ちょうどその行の後Application.CutCopyMode = False文を挿入しwstEnt.Range("B4").Insert Shift:=xlDown

後にアクティブのまま：

Function nyMndFunction(navnArk As String) 
    Dim gammelMnd As String, monthNames As String 

    ... 

    wstEnt.Range("B4").Insert Shift:=xlDown 

    Application.CutCopyMode = False '<-- statement to be inserted 

    wstEnt.Cells(4, 2).value = nyMnd 
    wstEnt.Cells(3, 3).Select 
End Function 

Furthe rmore次のダウン短縮コードを検討する必要があります。それはそれはSubだ何も返さないので、

nyMndSubボタン

Private Sub cmd_NyMndBravida_Click() 

    nyMndFunction ActiveSheet '<--| just pass the worksheet itself, without having to evaluate its name here and then evaluate it back to the worksheet object in 'nyMndFunction' 

End Sub 

に添付

コードを、そうしてみましょうそれを書いて、そのような名前を付けてください！あなたがリンクドキュメントから見ることができるように、それはゼロベースの配列を返す

区切り文字と文字列から配列を返すために[分割（）]/https://msdn.microsoft.com/en-us/library/office/gg278528.aspx）機能を使用しています

Option Explicit 

Sub nyMndSub(wstEnt As Worksheet) 
    Dim monthNames As String, nyMnd As String 
    Dim iMonth As Long 
    Dim wstMal As Worksheet 

    Set wstMal = Worksheets("Mal") 

    monthNames = "JANUAR,FEBRUAR,MARS,APRIL,MAI,JUNI,JULI,AUGUST,SEPTEMBER,OKTOBER,NOVEMBER,DESEMBER" '<--| month names list string 

    iMonth = InStr(monthNames, wstEnt.Cells(4, 2).value) '<--| look for the cell content in the month names list 
    If iMonth > 0 Then '<--| if found... 
     iMonth = Len(Left(monthNames, iMonth)) - Len(Replace(Left(monthNames, iMonth), ",", "")) + 1 '<--| get its "position" inside the list by counting the delimiter occurrences before it and skip to the "next" one 
     If iMonth = 12 Then iMonth = 0 '<--| if the "next position" is outside the 12-elements month names list then skip back to the first element 
     nyMnd = Split(monthNames, ",")(iMonth) '<--| get the month names in the finally selected "position" 

     wstMal.Range(wstMal.Cells(1, 1), wstMal.Cells(41, 11)).Copy '<-- do the copy juts when needed 
     With wstEnt 
      .Range("B4").Insert Shift:=xlDown 
      Application.CutCopyMode = False '<--| exit cutcopymode as soon as possible, i.e. after the clipboard content hs been exploited and no longer needed 
      .Cells(4, 2).value = nyMnd 
      .Cells(3, 3).Select 
     End With 
    End If 
End Sub 

上記のコードが対処するときに対処するようにiMonthインデックス