VBA .VBProject.VBComponents.Item(“ThisWorkbook”)。CodeModule.AddFromString无法正常工作

时间:2016-09-07 18:31:52

标签: excel vba

我正在动态创建一堆链接的工作簿,我需要禁止链接警告,因此我尝试使用正确的代码添加// Try this code on your jsfiddle // https://jsfiddle.net/g60ogt8c/1/ $(function() { function findColumnByDate(date) { var col; $('#ft_agenda thead th').each(function(idx) { if ($(this).text().trim() == date.trim()) col = idx; }); return col; } function showAvailableTimes(date) { var times = [], column = findColumnByDate(date); if (column) { var $rows = $('#ft_agenda tbody td:nth-of-type('+column+')'); if ($rows.length) { times[0] = ''; $rows.find('button').each(function() { times[times.length] = $(this).attr('value')+' - '+$(this).attr('title'); }); times[0] = 'For date '+date+' found '+(times.length-1)+' free terms'; } else { times[0] = ['No free terms for date: '+date]; } } else { times[0] = ['Invalid date '+date+' or date not found']; } return times; } // Function showAvailableTimes() now returns array. // In index 0 is status message and if available times found, // these lies on indexes 1 and more. // Use it this way: $('#out').html(''); showAvailableTimes('15-09-2016').forEach(function(item) { $('#out').append(item + '<br>'); }); // Or this way: // Jsonify returned array and send it toSome.php. var json = JSON.stringify(showAvailableTimes('09-09-2016')); $.post('toSome.php', {times: json}); // Or if there are free terms, filter status message // and send just free terms - without status message. var times = showAvailableTimes('09-09-2016'); if (times.length > 1) { var json = JSON.stringify(times.filter(function(itm,idx){return idx>0})); $.post('toSome.php', {times: json}); // Here you can see that status message was skipped $('#out2').text(json); } }); 子。

唯一的问题是代码实际上没有添加到工作簿中。

Workbook_Open()

创建文件并且一切正常,除了实际上没有代码添加到我刚刚创建的工作簿中,这是一个普通的工作簿,其ThisWorkbook是空白的。 (我还检查过我没有压制有关动态代码编写的任何警告,只是正常的saveas提示)。

我该如何做到这一点?

1 个答案:

答案 0 :(得分:1)

这适用于我,没有提示或缺少代码:

Sub test()

    Dim wbnew As Workbook

    Set wbnew = Workbooks.Add


    Application.DisplayAlerts = False
    wbnew.SaveAs Filename:="C:\temp\abc.xlsm", FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    wbnew.VBProject.VBComponents.Item("ThisWorkbook").CodeModule.AddFromString ( _
        "Private Sub Workbook_Open()" & vbCrLf _
        & "    Application.AskToUpdateLinks = False" & vbCrLf _
        & "    Application.DisplayAlerts = False" & vbCrLf _
        & "End Sub")

    wbnew.Close True
    Application.DisplayAlerts = True

End Sub

对于宏提示设置Fil - &gt;选项 - &GT;信托中心 - &gt;宏设置为此将摆脱提示: enter image description here