问题[vba](coding)

我想在节页脚的中心插入以下格式的页码。1/10、2/10、... 10/10

我尝试了以下代码，它将 1/10 插入到页脚左侧。

    Set rngHeader = wdDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
    rngHeader.Delete
    With rngHeader
        '.InsertAfter Text:="Page "

        '.MoveEnd wdCharacter, 0
        .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="NUMPAGES", PreserveFormatting:=False

  
        .InsertAfter Text:="  / "
        .Collapse wdCollapseStart
        .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
    End With

我无法控制特殊字段的插入。我是 Word VBA 的新手。

先谢谢各位专家了。

-- 苏布

我有此代码，用于使用映射表将输入文本中的每个字母转换为新文本

Attribute VB_Name = "Module1"
Option Compare Database

Function ReplaceLetters(inputText As String) As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Integer
    Dim originalChar As String
    Dim mappedChar As String
    Dim newText As String
    
    ' Open the database and the lookup table
    Set db = CurrentDb
    Set rs = db.OpenRecordset("LetterMapping", dbOpenSnapshot) ' Lookup table name
    
    newText = inputText
    
    ' Loop through each letter in the text
    For i = 1 To Len(inputText)
        originalChar = Mid(inputText, i, 1) ' Get the character at position i
        
        ' Look up the replacement in the table
        rs.MoveFirst
        Do While Not rs.EOF
            If rs!OriginalLetter = originalChar Then
                mappedChar = rs!MappedLetter
                newText = Left(newText, i - 1) & mappedChar & Mid(newText, i + 1)
                Exit Do ' Stop searching once found
            End If
            rs.MoveNext
        Loop
    Next i
    
    ' Close the recordset
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    ReplaceLetters = newText
End Function

这是映射表：

代码运行良好，但有些字母会改变一个字母，例如，如果我在输入文本“ÌÍΔ中有这些字母，则在映射字母中只给出一个字母，即第一个字母“ج”

我现在很困惑。我在 Visio 中使用 VBA 制作一些自动图表，尽管我认为它是 Visio 并不重要。我已经定义了多个类，其中一些类相似，但由于各种原因，它们的属性略有不同。我有一些函数可以接受这些类之一的变量，但我需要具体知道将我的哪个类传递给该函数。

因此，我过去常常TypeName将我的班级名称作为字符串，然后使用if或select case块根据该名称选择操作。

我有一个文件，它完美地运行。我今天刚刚重新打开它，以确保我没有疯。我有一个名为的类，Dimension_Compound并且在函数中有一个语句，If TypeName(theseTopDims) = "Dimension_Compound"其中theseTopDims是一个变体，该变体是一个数组，可以是我的自定义类之一，Dimension_Base也Dimension_Compound可以是整数数组。并且它可以正确编译和执行，没有问题。

我今天正在处理一个新的基于宏的图表。我有一个类似的语句，Select Case TypeName(newShape)其中newShapeVariant 可以是我的自定义类，PLMShape也可以是标准 VisioShape类型。而且，它在那一行上卡住了。我收到错误： Wrong Number of arguments or invalid property assignment

因此，我查看了Microsoft Learn 帮助页面，其中明确指出：“必需的 varname 参数是一个包含除用户定义类型的变量之外的任何变量的变量。 ”

所以，现在我的问题不是为什么我的新代码不起作用，而是我的旧代码怎么可能起作用？我在之前的项目中完全没有意识到这个要求——然而，它起作用了，当我今天加载它时，它继续起作用。我检查了所有参考库，甚至将这些库添加到我的新项目中，看看其中一个库是否添加了功能，TypeName但即使添加了这些引用，它仍然给我同样的错误。

在我的代码中，我在用户窗体上有一个组合框。用户从下拉列表中选择一个选项，然后用户窗体将选定的值设置为全局变量“monthYearEntered”。

然后我有一个使用全局变量的子程序。但是，全局变量的值没有转移到子程序中。我知道，因为我在用户窗体中创建了变量的 MsgBox，然后在子程序中再次创建了变量的 MsgBox。我在窗体中得到了正确的值，但在程序中却没有。

我研究了一下，找到了一些可能的解决方案，但对我来说都不起作用。在过去的一些代码中，我通过将单元格设置为值，然后引用单元格来设置子程序中的变量，从而找到了一种解决方法。我想避免这种情况，因为它只是一个创可贴。

用户表单代码

Private Sub CBN_OK_Click()

If YearMonthField = "" Then
    MsgBox "Value cannot be blank. Please enter correct value."
    Exit Sub
Else
    monthYearEntered = YearMonthField.Value
    MsgBox monthYearEntered
    Me.Hide
    Application.Run "DeleteMonth"
End If

End Sub

模块

Option Explicit
Dim monthYearEntered As String

Private Sub RangetoDelete()

    Application.DisplayAlerts = False
    
    Dim ws As Worksheet
    Dim tableSalesCombined As ListObject
    Dim cell, rng As Range

    Set ws = ThisWorkbook.Worksheets("Sales Data Combined")
    Set tableSalesCombined = ws.ListObjects("Table_SalesCombined")
    Set rng = ws.Columns("I:I")
    
    DeleteMonthForm.Show 'show user form
    
    'monthYearEntered.ClearContents
    Application.Run "Protect"
    Application.DisplayAlerts = True
    
End Sub

Private Sub DeleteMonth()

    Application.DisplayAlerts = False
    
    Dim ws As Worksheet
    Dim tableSalesCombined As ListObject
    'Dim monthYearValue
    Dim cell, rng As Range

    Set ws = ThisWorkbook.Worksheets("Sales Data Combined")
    Set tableSalesCombined = ws.ListObjects("Table_SalesCombined")
    Set rng = ws.Columns("I:I")
    
    ws.Unprotect Password:=PassW

    'look for value entered by user (monthYearValue)
    Set cell = rng.Find(What:=monthYearEntered, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
    
    MsgBox monthYearEntered
    
    If cell Is Nothing Then
        MsgBox monthYearEntered & "not found in Combined Sales Data.  Please confirm value and try again."
        Exit Sub
    End If
    
    With tableSalesCombined
         .Range.AutoFilter Field:=9, Criteria1:=monthYearEntered
         If Not .DataBodyRange Is Nothing Then
            '.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
         End If
         '.Range.AutoFilter
    End With

    tableSalesCombined.AutoFilter.ShowAllData
    
    'monthYearEntered.ClearContents
    Application.Run "Protect"
    Application.DisplayAlerts = True
    
End Sub
  

由于我是 Access VBA 新手，请耐心等待。

这里有一个带有数据表的子表单，我想在弹出视图中显示它。

如果“弹出”为“否”，则会显示整个页面。

如果弹出为是，则仅显示以下内容：

这些是我的属性：

我尝试将“自动调整大小”设置为“否”，但发生了同样的事情。

我应该在属性中设置什么以便至少它会自动显示以下内容：

弹出窗口

尝试修改此设置，以便只删除当前年份之外的记录。之前，我一直在研究滚动的 12 个月范围以证明这一概念，现在我只需要保留当前年份的数据。我尝试了几种不同的方法，但无法弄清楚，不想每个月都进入并将月份数更改 1，有没有办法说如果日期不在 2025 年之内，就将其删除

数据中日期格式的示例 13/09/2024 4:35:16 pm

以前使用的代码

 Sub Delete_Rows() 'DELETE HISTORICAL DATA OVER 1 YEAR OLD
With Sheets("HistoricalData")
lr = .Cells(Rows.Count, "C").End(xlUp).Row
For i = lr To 2 Step -1
If CDate(.Cells(i, "C").Value) < DateAdd("m", -12, Date) Then 'SETS THE MONTH COUNT TO MORE THAN 12 MONTHS OLD
.Rows(i).EntireRow.Delete ' DELETES ROW

End If
Next i
End With
End Sub

我一直在按照本教程从 URL 中抓取数据，因为它非常符合我的需求（3 个 div 深）。不幸的是，StackOverflow 不再支持 IE，我无法测试本教程的代码以查看它是否按原样工作。就我而言，我无法使用 chrome 插件，并且必须先向网站进行身份验证，然后才能导航到 URL。我还尝试了问题 15191847 的解决方案 - 特别是gembird 的解决方案 - 它给了我同样的错误。

当我运行下面的程序时，我收到“运行时错误‘91’。我将 ie.document 打印到文本文件中，并验证我正在搜索的 div id 是正确的，并且它们已被捕获。错误继续出现Set Questions = QuestionList.Children。有什么想法为什么它会向我显示错误？

Dim ie As InternetExplorer
Dim html As HTMLDocument
Dim QuestionList As IHTMLElement, QuestionField As IHTMLElement
Dim Questions As IHTMLElementCollection, QuestionFieldLinks As IHTMLElementCollection, QuestionFields As IHTMLElementCollection
Dim Question As IHTMLElement

Dim RowNumber As Long
Dim votes As String, url As String, views As String, QuestionId As String

url = "<<my url>>"

'open Internet Explorer in memory, and go to website
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate url


'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE
  Application.StatusBar = "Trying to go to " & url
  DoEvents
Loop

Cells.Clear
'show text of HTML document returned
Set html = ie.Document

'close down IE and reset status bar
Set ie = Nothing
Application.StatusBar = ""

'put heading across the top of row 3
Range("A3").Value = "Field"
Range("B3").Value = "Values"

Set QuestionList = html.getElementByID("fieldgroup ")    
Set Questions = QuestionList.Children

RowNumber = 4

For Each Question In Questions
  If Question.className = "fieldrow _text-field" Then
    'get a list of all of the parts of this question, and loop over them
    Set QuestionFields = Question.all
    
    For Each QuestionField In QuestionFields
      'if this is the question's votes, store it (get rid of any surrounding text)
      If QuestionField.className = "fieldlabel" Then
        Cells(RowNumber, 1).Value = Trim(QuestionField.innerText)
      End If

      'likewise for views (getting rid of any text)
      If QuestionField.className = "fieldvalue" Then
        Cells(RowNumber, 2).Value = Trim(QuestionField.innerText)
      End If
    Next QuestionField
    'go on to next row of worksheet
    RowNumber = RowNumber + 1
    
  End If
Next
Set html = Nothing

HTML 输出如下所示。

<div class="fieldgroup " style="" group-title="">
 
<div class="fieldrow _text-field">

<div class="fieldlabel">Reporting</div>
<div class="fieldvalue">Yes</div>
 </div>
    
<div class="fieldrow _text-field">
<div class="fieldlabel">Annotate ''Yes''</div>
<div class="fieldvalue">Yes</div>
 </div>
...

我有一个数据表（子）表单，它从存储过程接收记录源，因此它不可更新。我想将一列值（仅在 Access 表单上）复制到未绑定的复选框（新列）中，以便用户可以单击它，然后事情就会发生。

我尝试以不同的方式设置值，但我总是只得到第一行的值 - 插入到所有行。

我从存储过程收到的信息：

我想要的是：

如果我将 ConfirmedCopy 的默认值设置为 =[Confirmed]，或者使用 VBA 执行相同操作，将得到以下结果。因此，它获取顶行的值并将其插入到 ConfirmedCopy 字段中的所有行：

我有一个 Word 文档，它是长聊天记录的导出，每个条目都包含一个 13 位 UNIX 时间戳。我需要将每个时间戳转换为常规/可读的日期/时间（例如，2025 年 1 月 17 日星期五，美国东部时间凌晨 2:47），并将常规转换附加在原始时间戳之后。我有一个宏，它基本上可以正常工作，但我的循环无法正确迭代。

该宏的目的是：

1. 搜索每个 13 位时间戳
2. 将该时间戳转换为常规日期/时间
3. 在时间戳后添加常规日期/时间
4. 迭代并找到下一个时间戳并重复

我不知道如何让 Range 变量将附加值粘贴/输入到文档中，然后迭代查找下一个时间戳（我太缺乏经验，不知道我做错了什么）

例如，第一个时间戳是“1702654591899”，预期的替换文本是：“1702654591899；2023 年 12 月 15 日星期五 - 美国东部标准时间上午 10:36:32”，我想重复下一个时间戳，直至文档结束。

以下是我带有注释的代码：

'Function converts UNIX 13 Digit Timestamp to date/time in Eastern Standard Time
'Subtracts 18,000,000 miliseconds to subtract 5 hours for Eastern Standard Time
'Adapted from FaneDuru's Solution at:
'https://stackoverflow.com/questions/73011816/excel-vba-convert-unix-timestamp-to-date-time

Function fromUNIX13DigitsEST(uT) As Date
   
   ''Original line that converts to UTC or GMT (I'm not sure which but it's
   ''5 hours later than intended so I commented it out but left it for info purposes)
   'fromUNIX13DigitsEST = CDbl(uT) / 86400000 + DateSerial(1970, 1, 1)
   
   'Modified from line above to account for Eastern Standard Time
   fromUNIX13DigitsEST = (CDbl(uT) - 18000000) / 86400000 + DateSerial(1970, 1, 1)

End Function


'Loops and Finds all 13 digit Unix Timestamps and replaces them with the Timestamp plus
'conventional date/time

Sub FindUnix13DigitTimestampsAndAddConventionalDateAndTime()

    Dim TimestampInstance As Range
    Dim TimestampAndConverted As String 'Artifact of the learning process kept to prevent loops

    Set TimestampInstance = ActiveDocument.Range
    
    With TimestampInstance.Find
        
        'Do I need more of these? Is this section the problem?
        .Text = "[0-9]{13}"
        .MatchWildcards = True
    
    Do While .Execute(Forward:=True) = True
      
      TimestampInstance.Select
      
      ' Used to test before adding the "TimestampInstance.Text = ..." line below
      ' Sets string variable equal to the original Timestamp and adds the standard date/time/time zone 
      ' Uses the Function above to convert the UNIX TimeStamp
      ' Kept to use in the MsgBox line below as a failsafe against a runaway loop
      ' Adapted from FaneDuru's Solution at
      ' https://stackoverflow.com/questions/73011816/excel-vba-convert-unix-timestamp-to-date-time

      TimestampAndConverted = TimestampInstance + "; " + Format(fromUNIX13DigitsEST(TimestampInstance), "dddd, mmmm d, yyyy - hh:nn:ss AM/PM") + " EST"
      
      ' PROBLEMATIC LINE THAT PARTIALLY DOES WHAT I INTENDED IT TO DO
      ' Duplicates the Function call above and adds standard date items
      ' Meant to replace each 13-digit timestamp with the timestamp plus standard date/time/time zone
      ' If commented out then loop iterates as intended and the MsgBox below displays each successive 
      ' output from the TimestampAndConverted variable

      TimestampInstance.Text = TimestampInstance + "; " + Format(fromUNIX13DigitsEST(TimestampInstance), "dddd, mmmm d, yyyy - hh:nn:ss AM/PM") + " EST"
      
      'Displays variable TimestampAndConverted above in a message box & helps prevent a runaway loop
      MsgBox TimestampAndConverted
      
      '
      '
      ' Should there be code here to allow the loop to iterate to next 13-digit timestamp
      ' or reset "TimestampInstance" variable??
      '
      '
      
      ''This isn't the solution since it ends up replacing the 13-digit timestamps with "" so I commented it out
      'TimestampInstance.Text = ""
    
    Loop
  
  End With

End Sub

我设法使用字符串变量在每次迭代中在 MsgBox 中显示预期的输出，但是当我尝试使用 Range 变量重复该过程并将替换文本输入 Range 时，它​​会卡在第一个时间戳并不断循环重新添加常规日期/时间。

以第一个时间戳（“1702654591899”）为例，它随后添加的文本是“；2023 年 12 月 15 日星期五 - 美国东部标准时间上午 10:36:32”，但循环只是不断重新添加“；2023 年 12 月 15 日星期五 - 美国东部标准时间上午 10:36:32”，所以最终结果是：

“1702654591899；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32 EST；2023 年 12 月 15 日星期五 - 上午 10:36:32美国东部标准时间；2023 年 12 月 15 日星期五 - 上午 10:36:32 美国东部标准时间；2023 年 12 月 15 日星期五 - 上午 10:36:32 美国东部标准时间；2023 年 12 月 15 日星期五 - 上午 10:36:32 美国东部标准时间……”

此时我按 CTRL+Break 键终止循环并结束宏。

如何在每个找到的时间戳后添加一次常规日期/时间，然后继续下一个时间戳？

寻找一个 vba 代码来更新所有字段，而不包含属于 Ask 字段的提示，例如 Print Preview 所包含的提示。但是，打开和关闭 Print Preview 的代码并不是我们想要的，因为它会将我带回到文档的顶部，而不是让我停留在我原来的页面上。我说的是这个代码：

Sub Update()

Application.ScreenUpdating = False
    With ActiveDocument
        .PrintPreview
        .ClosePrintPreview
    End With
    Application.ScreenUpdating = True
End Sub

除了告诉提示不显示之外，还有其他方法可以更新所有字段吗？或者 ask 字段的提示字段是它们固有的，在操作过程中不能禁用它们吗？

提前感谢您的支持

威廉