|
本帖最后由 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的微博 |
|