问题[vba](coding)

数据类型：自动编号、短文本、短文本、...

我想分离“assigned_to”列中的值。但是，我在第 16 行收到类型不匹配错误。

workOrderId = rstIn!work_order_id

我不知道问题是什么。

Option Compare Database

Sub TransformTable()
    Dim dbs As DAO.Database
    Dim rstIn As DAO.Recordset
    Dim rstOut As DAO.Recordset
    Dim arrParms() As String
    Dim workOrderId() As String
    Dim i As Long
    Set dbs = CurrentDb
    Set rstIn = dbs.OpenRecordset("teszt_in", dbOpenForwardOnly)
    Set rstOut = dbs.OpenRecordset("teszt_out", dbOpenDynaset)
    Do While Not rstIn.EOF
        If Not IsNull(rstIn!assigned_to) Then
            arrParms = Split(rstIn!assigned_to, ",")
            workOrderId = rstIn!work_order_id
            For i = 0 To UBound(arrParms)
                rstOut.AddNew
                rstOut!ID = rstIn!ID
                rstOut!assigned_to = arrParms(i)
                rstOut!work_order_id = workOrderId(i)
                rstOut.Update
            Next i
        End If
        rstIn.MoveNext
    Loop
    rstIn.Close
    rstOut.Close
End Sub

为什么包含远程脚本和 CSS 链接的本地 html 文件需要很长时间才能加载

例如，

<script src="example.com/ajax/font.js" type="123-text/javascript"></script>
<link href="example.com/ajax/Ajax.css" type="text/css" rel="stylesheet"/>

head 标签中有 10 个或更多

如果我删除 head 标签及其内容，则加载文件只需不到一秒钟

把它们留在里面，可能需要将近一分钟

它是否尝试连接这些文件？

主要目的是使用宏在 Catia 中通过公式链接两个参数。我尝试手动记录该过程，但代码没有给出完整的代码：

Sub CATMain()
Dim partDocument1 As partDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As part
Set part1 = partDocument1.part
Dim parameters1 As Parameters
Set parameters1 = part1.Parameters
Dim parameterSet1 As ParameterSet
Set parameterSet1 = parameters1.RootParameterSet
Dim parameterSets1 As ParameterSets
Set parameterSets1 = parameterSet1.ParameterSets
Dim parameterSet2 As ParameterSet
Set parameterSet2 = parameterSets1.GetItem("Construction_Position")
Dim parameterSets2 As ParameterSets
Set parameterSets2 = parameterSet2.ParameterSets
Dim parameterSet3 As ParameterSet
Set parameterSet3 = parameterSets2.GetItem("R_Point") ' Cannot print the method call put_Value for the object RealParam
Dim relations1 As Relations
Set relations1 = part1.Relations
Set parameterSet3 = parameterSets2.GetItem("R_Point")
Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formula.2", "", ' Cannot print the method call CreateFormula for the object Relations
part1.Update
End Sub

我从这个过程“手动”得到的最终公式是

formula.2: Construction_Position\R_Point\R_Point_X=Construction_Position\H_Point\H_Point_X

有人能帮我吗？我试过 CHATGPT，但根本不起作用

我正在使用我们的用户名在 Excel 的 VBA 中构建动态宏Environ("Username")，需要提取大写字符。因此 JohnSmith 变成了 JS

我无法让宏仅返回首字母。它只会给我一个空白的回复

'
' Macro1 Macro
'
Dim Username As String
Dim UserInits As String
Username = Environ("UserName")
Dim i As Integer
Dim spltStr() As String
spltStr = Split(Username)

UserInits = ""

i = 1
Do While i <= Len(Username)

    If UCase(spltStr(i)) = spltStr(i) Then
        UserInits = UserInits & spltStr(i)
    End If
    
i = i + 1
Loop

MsgBox UserInits

End Sub

有人能看到我做错什么了吗？

我不是 VBA 专家，但我正在尝试做一些非常简单的事情。我正在尝试从 Word 文档中的每个段落中删除前导空格。

这是我的 VBA 代码：

Function RemoveLeadingSpaces()
    Dim apara As Paragraph

    Application.ScreenUpdating = False
    For Each apara In ActiveDocument.Paragraphs

        'apara.Range.Text = Trim(apara.Range.Text)
        Debug.Print apara.Range.Text

    Next apara
    Application.ScreenUpdating = True
End Function

当我取消注释替换文本的行时，我开始遇到一些奇怪的行为。循环变得无限，并且只会一遍又一遍地应用/替换第一个项目/段落。如果我注释，则调试会按预期打印所有段落。

我做错什么了？

我正在尝试编写一个 VBA 脚本，用于对 Microsoft Word 表格行内的所有 2 级多列表项进行随机排序。我使用的是最新版本的 MS Word (Office 365)。

我几乎做对了，但我的脚本重新插入了行，但添加了一个额外的列表项。我设法从最后一段（最后一行）中删除了列表项编号，但我似乎无法删除段落本身。

我尝试选择最后一段并删除（这会删除该行的全部内容），我试过了para.Range.Delete- 这似乎没有任何作用。

Sub Func()
    Dim tbl As Table
    Dim curRow As Row
    Dim para As Paragraph
    Dim paras() As String
    Dim cnt As Integer
    Dim i As Integer, j As Integer
    Dim temp As String

    If Not Selection Is Nothing And Selection.Tables.Count > 0 Then
        Set tbl = Selection.Tables(1)
        Set curRow = Selection.Rows(1)
    Else
        MsgBox "Please place the cursor inside a table."
        Exit Sub
    End If

    ' Count the number of list level 2 items
    cnt = 0
    For Each para In curRow.Range.Paragraphs
        If para.Range.ListFormat.ListLevelNumber = 2 Then
            cnt = cnt + 1
        End If
    Next para
    
    ' Collect the items in an array and remove them from the list
    ReDim paras(1 To cnt)
    cnt = 0
    For Each para In curRow.Range.Paragraphs
        If para.Range.ListFormat.ListLevelNumber = 2 Then
            cnt = cnt + 1
            paras(cnt) = para.Range.Text
            para.Range.Text = ""
        End If
    Next para

    ' Shuffle the array
    Randomize
    For i = 1 To cnt - 1
        j = Int((cnt - i + 1) * Rnd + i)
        temp = paras(i)
        paras(i) = paras(j)
        paras(j) = temp
    Next i

    ' Insert shuffled items back as level 2 list entries
    For i = 1 To cnt
        curRow.Range.InsertAfter paras(i)
    Next i
    
    Set para = curRow.Range.Paragraphs(curRow.Range.Paragraphs.Count - 1)
    para.Range.ListFormat.RemoveNumbers
    ' para.Range.Delete - doesn't do anything
    
End Sub

我对 VBA 还很陌生。所以我不知道从哪里开始解决这个问题。我有一个电话号码条目，为了避免将来出现错误，我想强制输入的数据为空白/空或长度为 7 或 10，如果长度不正确，用户就无法离开该字段。

我尝试使用IF语句来确认长度，并且能够在条件不满足时弹出一个消息框，但我不知道如何保持焦点在那里直到输入正确的长度。

Private Sub InspWkPhone_AfterUpdate()
    Me.Refresh
    If Len(Me.InspWkPhone) <> 7 Then
        If Len(Me.InspWkPhone) <> 10 Then
            MsgBox (" Check Phone # MISSING digits! ")
        End If
    End If
End Sub

最终，电话号码前后会输入几种类型的数字数据。我试图避免将邮政编码或单价输入错误的位置。

我正在尝试在 Microsoft Word 中创建一个 VBA 宏，它将：

1. 首先选择一段文本作为“颜色键”。所选内容中的每一行都有唯一的颜色和文本字符串。

2. 存储选择中每行的字体颜色和文本。

3. 在文档的其余部分搜索字体颜色与“颜色键”选择中的任意颜色匹配的段落。

4. 将颜色键中匹配的文本添加到具有相同字体颜色的任何段落的前面。

如果选择了三行并且运行了宏，预期的输出应该是这样的。

代码，我尝试过

Sub ApplyColorKeyPrefixes()

    Dim doc As Document
    Dim selectedRange As Range
    Dim colorKeyColors As Collection
    Dim colorKeyPrefixes As Collection
    Dim para As Paragraph
    Dim line As Range
    Dim colorCode As Long
    Dim prefixText As String
    Dim i As Long

    ' Initialize document and collections for color key
    Set doc = ActiveDocument
    Set colorKeyColors = New Collection
    Set colorKeyPrefixes = New Collection
    Set selectedRange = Selection.Range

    For i = 1 To selectedRange.Paragraphs.Count
        Set line = selectedRange.Paragraphs(i).Range
        line.End = line.End - 1  ' Exclude paragraph mark

        ' Store the color and corresponding text
        colorCode = line.Font.Color
        prefixText = Trim(line.Text)

        On Error Resume Next
        colorKeyColors.Add colorCode, CStr(colorCode)
        colorKeyPrefixes.Add prefixText, CStr(colorCode)
        On Error GoTo 0
    Next i

    'oop through all paragraphs in the document (after selection) to find matches
    For Each para In doc.Paragraphs
        ' Skip paragraphs in the initial selection
        If para.Range.Start >= selectedRange.End Then
            Set line = para.Range.Words(1)  ' use first text of selection to determine color
            colorCode = line.Font.Color
            
            ' Check if color match in parag
            On Error Resume Next
            prefixText = colorKeyPrefixes(CStr(colorCode))
            On Error GoTo 0

            If prefixText <> "" Then
                para.Range.InsertBefore prefixText & ": "
                
                ' Retain color for the og text and the prefix text
                para.Range.Words(1).Font.Color = colorCode
                para.Range.Font.Color = colorCode
            End If
        End If
    Next para

    Set colorKeyColors = Nothing
    Set colorKeyPrefixes = Nothing

End Sub

问题 代码当前将前缀应用于所有段落，而不仅仅是字体颜色匹配的段落。我怀疑我在 colorKeyPrefixes 中检查字体颜色匹配的方式可能存在问题，但我不确定问题出在哪里。

我如何修改宏，以便它仅将前缀文本附加到与所选“颜色键”中的某一行具有相同字体颜色的段落？

附加说明 所选内容中的每一行都保证只有一种颜色。颜色键最多可包含 12 种不同的颜色。我使用每个段落的第一个单词来检查颜色（假设该颜色适用于整个段落）。

我正在尝试使用以下示例代码向 MS Access 中的 ADODB.Recordset 添加 adLongVarWChar 字段。

如果我执行此子程序，我会收到错误 3001：

参数类型错误、超出可接受范围或相互冲突。

所有其他数据类型都可以正常工作。

还有其他人经历过这种情况吗？

Public Sub Test()

    Dim rsADO As ADODB.Recordset
    Set rsADO = New ADODB.Recordset
    rsADO.CursorLocation = adUseClient

    rsADO.Fields.Append "Test", adLongVarWChar 

End Sub

这是文档链接。https: //learn.microsoft.com/en-us/sql/ado/reference/ado-api/append-method-ado?view =sql-server-ver16

我对 VBA 还很陌生，正在努力解决一些我认为应该很简单的问题。在 Outlook 用户表单中，我想使用从全局地址列表中选择的电子邮件地址为标签（“CourrielSup”）添加标题。

我尝试使用 Microsoft 知识库中的 SelectNamesDialog.Display 方法来访问全局地址簿。这种方法很有效，当我单击命令按钮“ListeAdresse”时，会弹出显示地址簿的对话框。但我找不到让选定的电子邮件地址成为标签标题的方法。考虑到我的新手，我尝试了一些随机方法，看看是否可行，但我不知所措，而且我找不到在线资源来帮助我。这是我的非功能性代码：

Private Sub ListeAdresse_Click()
 Dim Courriel As String
 Dim oDialog As SelectNamesDialog
 Set oDialog = Application.Session.GetSelectNamesDialog
 With oDialog
 .InitialAddressList = Application.Session.GetGlobalAddressList
 If .Display Then
    CourrielSup.Caption = .Recipients
 End If
 End With
End Sub