ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 33313|回复: 22

[求助] 改成win7 64位 旗舰版+Office2010 64位后,原来的加载宏出现了问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-12-25 16:15 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:数据类型和基本语句
本帖最后由 wshcw 于 2011-12-25 16:16 编辑

我的系统改成:win7 64位  旗舰版+Office2010 64位后原来的加载宏出现了问题,红色部分有问题,代码如下:

Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub ComboBox1_Change()
If ComboBox1.Text = "式样一" Then
Image2.Visible = True
Image1.Visible = False
Label7.Enabled = False
TextBox3.Enabled = False
Else
Image1.Visible = True
Image2.Visible = False
Label7.Enabled = True
TextBox3.Enabled = True
End If
End Sub
Private Sub CommandButton1_Click()
With Selection
If .MergeCells = True Then
If ComboBox2.Text = "12" Then
.Font.Size = 12
.RowHeight = 42
ElseIf ComboBox2.Text = "9" Then
.RowHeight = 36
.Font.Size = 9
End If
End If
.WrapText = True
.HorizontalAlignment = xlLeft
End With
If ComboBox1.Text = "式样二" Then
With Selection
If Len(TextBox1.Text) <= 3 Then
If ComboBox2.Text = "12" Then
.ColumnWidth = 16
ElseIf ComboBox2.Text = "9" Then
.ColumnWidth = 10.5
End If
If Len(TextBox2.Text) >= 5 Then
.ColumnWidth = 27
End If
ElseIf Len(TextBox1.Text) = 4 Then
If ComboBox2.Text = "12" Then
.ColumnWidth = 22
ElseIf ComboBox2.Text = "9" Then
.ColumnWidth = 19.5
End If
If Len(TextBox2.Text) >= 5 Then
.ColumnWidth = 27
End If
ElseIf Len(TextBox1.Text) = 5 Then
If ComboBox2.Text = "12" Then
.ColumnWidth = 27
ElseIf ComboBox2.Text = "9" Then
.ColumnWidth = 22.5
End If
If Len(TextBox2.Text) >= 5 Then
.ColumnWidth = 27
End If
End If
If ComboBox2.Text = "12" Then
a = Int(.Width / 9.5)
Else
a = Int(.Width / 9.5) + 2.3
End If
.WrapText = True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
If ComboBox2.Text = "12" Then
.Font.Size = 12
.RowHeight = 42
ElseIf ComboBox2.Text = "9" Then
.RowHeight = 36
.Font.Size = 9
End If
End With
Selection = Space(a) & TextBox1.Text & Chr(10) & Space(a / 2 + 1) & TextBox2.Text & Chr(10) & TextBox3.Text
Set myDocument = ActiveSheet
With myDocument.Shapes
.AddLine(Selection.Left, Selection.Top + 1, Selection.Left + Selection.Width, Selection.Top + Selection.Height / 2 + 1).Line.DashStyle = 1
.AddLine(Selection.Left - 1, Selection.Top, Selection.Left + Selection.Width / 2 - 1, Selection.Top + Selection.Height).Line.DashStyle = 1
End With
Else
With Selection
.WrapText = True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders.LineStyle = xlContinuous
If Len(TextBox1.Text) <= 4 Then
If ComboBox2.Text = "12" Then
.Font.Size = 12
.RowHeight = 36.75
.ColumnWidth = 14
ElseIf ComboBox2.Text = "9" Then
.RowHeight = 24
.Font.Size = 9
.ColumnWidth = 10
End If
Else
If ComboBox2.Text = "12" Then
.Font.Size = 12
.RowHeight = 36.75
.ColumnWidth = 18
ElseIf ComboBox2.Text = "9" Then
.RowHeight = 24
.Font.Size = 9
.ColumnWidth = 12
End If
End If
Selection = Space(5) & TextBox1.Text & Chr(10) & Space(0) & TextBox2.Text
End With
End If
Unload Me
End Sub
Private Sub CommandButton2_Click()
If Selection.Count > 1 Then Exit Sub
Dim shap As Shape
For Each shap In ActiveSheet.Shapes
If (Not Application.Intersect(Range(shap.TopLeftCell.Address, shap.BottomRightCell.Address), ActiveCell) Is Nothing) Then
shap.Select
Selection.Delete
End If
Next
Selection.Clear
ActiveCell.EntireRow.AutoFit
End Sub
Private Sub TextBox1_Change()
If Len(TextBox1.Text) > 5 Then
MsgBox "字数太多了", 48, "提示"
TextBox1.Text = Mid(TextBox1.Text, 1, 5)
End If
End Sub
Private Sub TextBox2_Change()
If Len(TextBox2.Text) > 5 Then
MsgBox "字数太多了", 48, "提示"
TextBox1.Text = Mid(TextBox2.Text, 1, 5)
End If
End Sub
Private Sub TextBox3_Change()
If Len(TextBox3.Text) > 5 Then
MsgBox "字数太多了", 48, "提示"
TextBox1.Text = Mid(TextBox3.Text, 1, 5)
End If
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "式样一"
ComboBox1.AddItem "式样二"
ComboBox2.AddItem "9"
ComboBox2.AddItem "12"
ComboBox1.Text = "式样一"
ComboBox2.Text = "9"
Dim hWndForm&, hIcon&
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
hIcon = ExtractIcon(0, Environ("Systemroot") & "\explorer.exe", 10)
SendMessage hWndForm, &H80, False, hIcon
End Sub
============================================================================
请各位VBA高手帮忙改代码,使其在64位系统下能使用.谢谢了.


该贴已经同步到 wshcw的微博

点评

知识树索引:5楼  发表于 2014-2-25 12:33

TA的精华主题

TA的得分主题

发表于 2011-12-25 16:46 | 显示全部楼层
API的声明部分改一下:
  1. #If Win64 Then
  2. Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
  3. Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
  4. Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
  5. #Else
  6. Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
  7. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
  8. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  9. #End If
复制代码
另外调用API的时候定义变量的话有些也需要修改,手头没有64位,无法调试。

TA的精华主题

TA的得分主题

发表于 2011-12-25 17:14 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
实际上,一些微软自己的Office插件目前都不能兼容64位Office 2010,包括Outlook Social Connector,更不用说第三方开发的插件了。

微软建议安装32位Office 2010而非64位版

TA的精华主题

TA的得分主题

发表于 2011-12-25 17:26 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
看一下pup7里面的例子
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function HtmlHelp Lib "HHCtrl.ocx" Alias "HtmlHelpA" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As LongPtr
    Private Declare PtrSafe Function RegOpenKeyA Lib "ADVAPI32.DLL" (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As Long
    Private Declare PtrSafe Function RegCloseKey Lib "ADVAPI32.DLL" (ByVal hKey As LongPtr) As Long
    Private Declare PtrSafe Function RegSetValueExA Lib "ADVAPI32.DLL" (ByVal hKey As LongPtr, ByVal sValueName As String, ByVal dwReserved As Long, ByVal dwType As Long, ByVal sValue As String, ByVal dwSize As Long) As Long
    Private Declare PtrSafe Function RegCreateKeyA Lib "ADVAPI32.DLL" (ByVal hKey As LongPtr, ByVal sSubKey As String, ByRef hkeyResult As LongPtr) As Long
    Private Declare PtrSafe Function RegQueryValueExA Lib "ADVAPI32.DLL" (ByVal hKey As LongPtr, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long

#Else
    Private Declare Function HtmlHelp Lib "HHCtrl.ocx" Alias "HtmlHelpA" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long
    Declare Function RegOpenKeyA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
    Declare Function RegCloseKey Lib "ADVAPI32.DLL" (ByVal hKey As Long) As Long
    Declare Function RegSetValueExA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByVal dwType As Long, ByVal sValue As String, ByVal dwSize As Long) As Long
    Declare Function RegCreateKeyA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
    Declare Function RegQueryValueExA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long
#End If


    #If VBA7 And Win64 Then
        Dim TheKey As LongPtr
        Dim hKey As LongPtr

    #Else
        Dim TheKey As Long
        Dim hKey As Long
    #End If

TA的精华主题

TA的得分主题

发表于 2011-12-25 17:29 | 显示全部楼层
下面的示例演示如何在 Declare 语句中使用其中某些项。
VBA

                                                Declare PtrSafe Function RegOpenKeyA Lib "advapi32.dll" (ByVal Key As LongPtr, ByVal SubKey As String, NewKey As LongPtr) As Long
                                       

请注意,没有 PtrSafe 属性的 Declare 语句被假定为与 64 位版本的 Office 2010 不兼容。

如前所述,有两个新的条件编译常量:VBA7 和 Win64。为确保与以前版本的 Office 的向后兼容性,可使用 VBA7 常量(这是较典型的情况)来防止 64 位代码在早期版本的 Office 中运行。对于在 32 位版本和 64 位版本之间有所不同的代码(例如调用数学 API,它对其 64 位版本使用 LongLong,对其 32 位版本使用 Long),可使用 Win64 常量。下面的代码演示如何使用这两个常量。
VBA

#if Win64 then
   Declare PtrSafe Function MyMathFunc Lib "User32" (ByVal N As LongLong) As LongLong
#else
   Declare Function MyMathFunc Lib "User32" (ByVal N As Long) As Long
#end if
#if VBA7 then
   Declare PtrSafe Sub MessageBeep Lib "User32" (ByVal N AS Long)
#else
   Declare Sub MessageBeep Lib "User32" (ByVal N AS Long)
#end if

总而言之,如果您编写 64 位代码并打算在以前版本的 Microsoft Office 中使用它,则需要使用 VBA7 条件编译常量。不过,如果您在 Office 2010 中编写 32 位代码,则该代码的工作方式与在以前版本的 Microsoft Office 中一样,无需使用编译常量。如果希望确保对 32 位版本使用 32 位语句,对 64 位版本使用 64 位语句,则最好选择使用 Win64 条件编译常量。
使用条件编译属性

下面的代码是需要更新的旧 VBA 代码的示例。请注意旧代码中更新为使用 LongPtr 的数据类型,因为它们引用句柄或指针

旧 VBA 代码
VBA

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  
Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

新 VBA 代码
VBA

#if VBA7 then    ' VBA7
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
  hOwner As LongPtr
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As LongPtr
  lParam As LongPtr
  iImage As Long
End Type

#else    ' Downlevel when using previous version of VBA7

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

#end if
Sub TestSHBrowseForFolder ()
    Dim bInfo As BROWSEINFO
    Dim pidList As Long

    bInfo.pidlRoot = 0&
    bInfo.ulFlags = &H1
    pidList = SHBrowseForFolder(bInfo)
End Sub

TA的精华主题

TA的得分主题

发表于 2011-12-25 17:31 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
32 位和 64 位版本的 Office 2010 之间的兼容性.rar (4.22 KB, 下载次数: 1215)

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-12-25 22:15 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 wshcw 于 2011-12-25 23:10 编辑

问题确实比较麻烦,涉及要改的部分较多。所以还是改用OFFICE2010的32位好。

TA的精华主题

TA的得分主题

发表于 2011-12-25 22:20 | 显示全部楼层
本帖最后由 liucqa 于 2017-5-17 21:42 编辑
wshcw 发表于 2011-12-25 22:15
问题确实比较麻烦,要改的部分较好。所以还是改用OFFICE2010的32位好。

这有自动修改api的工具http://club.excelhome.net/thread-1340930-1-2.html

TA的精华主题

TA的得分主题

发表于 2011-12-25 22:28 | 显示全部楼层
开始时编译一般就可以的用#if Win64 then
对于API的一般都要改

TA的精华主题

TA的得分主题

发表于 2012-2-3 16:53 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-8 21:34 , Processed in 0.033746 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表