Excelのワークシート上に画像(pic1)と四角の図形(waku)があります。
pic1にwakuを重ね、トリミングする場所を視覚的に確認したあと、VBAを実行し、wakuと同じ位置・サイズでpic1をトリミングするということを考えています。
とりあえず、実験的に左側をトリミングするマクロを作ってみましたがうまくいきません。
やってみた手順としては・・・
1.wakuの左端位置を取得
2.pic1の左端位置を取得
3.その差分を取得
4.差分と同サイズ、pic1の左側をトリミングする
・・・です。
Sub 左端をトリミング()
'枠の位置を取得
Dim wLeft As Single
wLeft = ActiveSheet.Shapes("waku").Left
'写真の位置を取得
Dim pLeft As Single
pLeft = ActiveSheet.Shapes("pct1").Left
'左側の差分を取得
Dim lTrim As Single
lTrim = wLeft - pLeft
ActiveSheet.Shapes("pct1").Select
Selection.ShapeRange.PictureFormat.CropLeft = lTrim
End Sub
結果としては想定しているものの２倍分くらい、トリミングされてしまいます。
最後の一文が、よくわからないまま、ネットから拾ってきた感じで使用しており、そこに問題があるのかと思うのですが・・・
どのようにするのが正しいのか、教えていただければ幸いです。
最終的には同様に上端を、右端・下端についてはそれぞれの図形のサイズの差からトリミングすべきポイントを抽出して希望のサイズにトリミングするつもりでいます。
ちなみに趣旨は・・・
・PCの知識の少ない人でも出来るようにしたい。
・wakuをリサイズさせないことで、縦横比・画像サイズを固定したい。
・・・というものです。
「VBAなんか使わなくても、こうすれば簡単じゃん！」みたいな方法があればあわせて教えていただ得れば幸いです。
VBA初心者です。
VBAの勉強もかねて、今、【 標準モジュール 】と【 UserForm 】を用いて
あるプログラムを作っています。
その中で、プロシージャ間をまたいで 『 値の受け渡し 』をしたいと思っています。
今回、質問をさせていただいたのは、その『 値の受け渡し 』が
「できる場合」と「できない場合」があるので、常にできるように
その対応方法を教えていただきたく、今回投稿させていただきました。
----------------------------------------------------------------
今困っているパターンを例にあげると、
ユーザフォームの中に２つのボタン 「OK」ボタンと「キャンセル」ボタンが
あるとします。
【 「キャンセル」ボタンがおされた場合には「終了する」 】という
仕組みにしたいと思っています。
そこで以下のようなプログラムを作ろうとしました。
----------------------------------------------------------------
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
１） General部にPublic変数（以下「P変数」）を宣言する。
Public cancel as byte
２） 【標準モジュール】のプロシージャから【フォーム】の「Userform1」を表示させる。
Sub A処理（）
Userform1.show
End sub
３） 【フォーム】のUserform1._CommandButton2に以下のように記述する。
（キャンセルボタンがクリックされた場合）
Private Sub CommandButton2_Click()
cancel = False
Unload Me
Exit Sub
End Sub
４） 【標準モジュール】のプロシージャの、一連の処理の最後に
以下のようにプログラムを記述する。
Sub A処理（）
Userform1.show
↓
↓
if cancel = false then
exit sub
end if
End sub
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
１）～４）のようにして
「キャンセルがクリックされた場合、すべての処理を終了する。」
というようなプログラムを記述してみました。
すると、デバッグを使って、変数「cancel」の中身を見てみると
３）の段階で、その変数「cancel」に「false」値を格納したはずなのに、
プロシージャ間をまたいだことで
４）の段階では、変数「cancel」の中身が必ず「""」と
値が空値になってしまいます。
４）の段階でも、変数「cancel」の値が保持できる、
何かしらの方法はないでしょうか。
回答をよろしくお願いします。
ExcelのVBAについてです。
ネットのサイトなどを参考に勉強しはじめたばかりなので、非常に初歩的な質問かと思いますが、よろしくお願いいたします。
ユーザーフォームにコンボボックスとテキストボックスを用意しました。
それぞれコンボボックスは「combobox1」、テキストボックスは「textbox1」とします。
コンボボックスからプルダウンで項目が選択できるよう
Private Sub UserForm_Initialize()
With combobox1
.AddItem "りんご"
.AddItem "ぶどう"
.AddItem "みかん"
.AddItem "もも"
End With
End Sub
としました。
各項目が選択されたときに、テキストボックス「textbox1」にはそれぞれの固定値が入るようにしたいです。
（例えばりんごなら1、ぶどうなら3、みかんなら10、ももなら25といったような感じで）
Private Sub combobox1_Click()
Dim listno As Long
listno = combobox1.ListIndex
With textbox1
Select Case para
Case 0
.Text = 1
Case 1
.Text = 3
Case 2
.Text = 10
Case 3
.Text = 25
End Select
End With
End Sub
としました。
しかし、実行してみると、最初選択したときはtextbox1には数値が入るのですが、その後違う項目を選択してもtextbox1の値は変わりません。
どのようにしたらよいのでしょうか？
また、根本的なことなのですが、なぜ
.Additem "りんご"
ではメソッド(.Additemってメソッドですよね？）ではメソッドと値を並べて記述するのに、
case 0
.text = 1
では =で結ぶのでしょうか？（.textもメソッドですよね？）
ExcelのVBAについてです。
ネットのサイトなどを参考に勉強しはじめたばかりなので、非常に初歩的な質問かと思いますが、よろしくお願いいたします。
ユーザーフォームにコンボボックスとテキストボックスを用意しました。
それぞれコンボボックスは「combobox1」、テキストボックスは「textbox1」とします。
コンボボックスからプルダウンで項目が選択できるよう
Private Sub UserForm_Initialize()
With combobox1
.AddItem "りんご"
.AddItem "ぶどう"
.AddItem "みかん"
.AddItem "もも"
End With
End Sub
としました。
各項目が選択されたときに、テキストボックス「textbox1」にはそれぞれの固定値が入るようにしたいです。
（例えばりんごなら1、ぶどうなら3、みかんなら10、ももなら25といったような感じで）
Private Sub combobox1_Click()
Dim listno As Long
listno = combobox1.ListIndex
With textbox1
Select Case para
Case 0
.Text = 1
Case 1
.Text = 3
Case 2
.Text = 10
Case 3
.Text = 25
End Select
End With
End Sub
としました。
しかし、実行してみると、最初選択したときはtextbox1には数値が入るのですが、その後違う項目を選択してもtextbox1の値は変わりません。
どのようにしたらよいのでしょうか？
また、根本的なことなのですが、なぜ
.Additem "りんご"
ではメソッド(.Additemってメソッドですよね？）ではメソッドと値を並べて記述するのに、
case 0
.text = 1
では =で結ぶのでしょうか？（.textもメソッドですよね？）
エクセルVBAで在庫管理をしたいと思っていますが、難しく前へ進まず悩んでいます。
すいませんが、ご教授ください。
一つのシートに下表のような表があります。
これをロットをキーとして一行にまとめ、在庫数まで求めたいです。
いい方法はありませんか？
製品 ロット 入庫 出庫 在庫
A 1111 1000
A 1112 1000
A 1112 500
A 1111 500
A 1111 1000
超初心者なのですが、業務処理の簡素化のため、色々調べながら、下記を作りました。
が、、、うまく動いてくれません。。
やりたいことは、D列に「OK」とある行を、「終了リスト」というSheetにコピーし、コピーした行を削除。
その処理の前に、メッセージボックスで処理を進めて問題ないか確認する。。。です。
メッセージボックスでの処理分岐を入れようとして、色々記述を変えたところ、エラーになってしまいました。。。
どなたか、お詳しい方がいらっしゃいましたら、誤っている箇所をご指摘、ご教授いただけないでしょうか。
それから、もし可能であれば件数が０件の場合は、「対象なし」と表示したいです。
どうぞ宜しくお願いいたします。
Sub 終了処理()
Dim cnt As Long
Dim chk As Integer
Dim i, LastRow As Long
Dim myMsg1 As String, myMsg2 As String
myMsg1 = "終了件数は"
myMsg2 = "件です。完了しますか？"
cnt = WorksheetFunction.CountIf(ActiveSheet.Range("A3:A65536"), "OK")
chk = MsgBox(myMsg1, cnt, myMsg2, vbYesNo)
If chk = vbYes Then
LastRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 4) = "OK" Then
Rows(i).Copy Sheets("終了リスト").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Rows(i).Delete shift:=xlUp
Next i
End If
End Sub
どうぞ宜しくお願いいたします。
超初心者なのですが、業務処理の簡素化のため、色々調べながら、下記を作りました。
が、、、うまく動いてくれません。。
やりたいことは、D列に「OK」とある行を、「終了リスト」というSheetにコピーし、コピーした行を削除。
その処理の前に、メッセージボックスで処理を進めて問題ないか確認する。。。です。
メッセージボックスでの処理分岐を入れようとして、色々記述を変えたところ、エラーになってしまいました。。。
どなたか、お詳しい方がいらっしゃいましたら、誤っている箇所をご指摘、ご教授いただけないでしょうか。
それから、もし可能であれば件数が０件の場合は、「対象なし」と表示したいです。
どうぞ宜しくお願いいたします。
Sub 終了処理()
Dim cnt As Long
Dim chk As Integer
Dim i, LastRow As Long
Dim myMsg1 As String, myMsg2 As String
myMsg1 = "終了件数は"
myMsg2 = "件です。完了しますか？"
cnt = WorksheetFunction.CountIf(ActiveSheet.Range("A3:A65536"), "OK")
chk = MsgBox(myMsg1, cnt, myMsg2, vbYesNo)
If chk = vbYes Then
LastRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 4) = "OK" Then
Rows(i).Copy Sheets("終了リスト").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Rows(i).Delete shift:=xlUp
Next i
End If
End Sub
どうぞ宜しくお願いいたします。
環境：WindowsXPSP3 Office2010です。
ヤリタイ事その1
(1)BookAのSeet4以降にSheet(1行目のセルには項目が入っています、列数はみな同じです。行数は違います)を追加していきたい。
(2)使っていないSheet1,2,3はスキップする。一行目には、何年何組、男女の区別、生徒氏名、生徒証番号、1学期の中間試験の国語の成績、1学期の期末試験の国語の成績、担当教員名、2学期の中間試験の算数の成績、担当教員名、・・・・・・
(3)追加したSheetnの最後のSheetnにもう一つSheetn+1を追加したい。
(4)Seet4からSheetnまでの各SheetのセルをSheetn+1に「下向けに」貼り付けていきたい。
(5)何年何組が40あったら、まづ、40行、次に何年何組が20あったら、次の20行、・・・・
前回ご指導頂いた方法で試しました。ちょっと変更しましたが、その時は、ほぼ旨くいきました。
Worksheets.Add Before:=Worksheets(1)
Dim sheetsuu As Integer 'sheetsuuはシートの数です。
Dim kk As Integer
Dim m As Integer
sheetsuu = ActiveWorkbook.Worksheets.count
For kk = 4 To sheetsuu - 1 Step 1
Worksheets(kk - 3).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
しかし、Sheetn+1にSheet4の1行目をPasteしようしましが、旨くいきません。
要するに項目がcopy,Pasteとしようとしましたが、旨くいきません。
手打ちでは、出来ます。Sheet4の一行目Ctrl+C シートの最後まで行き、Ctrl+Vで出来ます。
しかし、マクロを使うと出来ません。どなたか、ご指導して頂けませんでしょうか？
何卒宜しくお願い申し上げます。
ヤリタイ事その2
(1)上記【ヤリタイ事その1】が、出来たら、Sheetn+1を別のBook1.xlsxに
copy,Pasteとしようとしましたが、旨くいきません。
これも色々検索しました。
試した数、デバック文を入れた物沢山ありますが、旨くいきそうな例を下記にしまします。
下記も旨くいかない例です。
Dim nWbk As Workbook
Set nWbk = Workbooks.Add
ThisWorkbook.Worksheets("Sheet &kk").Copy Before:=Worksheets("Sheet1")
どなたか、ご指導して頂けませんでしょうか？
何卒宜しくお願い申し上げます。
環境：WindowsXPSP3 Office2010です。
ヤリタイ事その1
(1)BookAのSeet4以降にSheet(1行目のセルには項目が入っています、列数はみな同じです。行数は違います)を追加していきたい。
(2)使っていないSheet1,2,3はスキップする。一行目には、何年何組、男女の区別、生徒氏名、生徒証番号、1学期の中間試験の国語の成績、1学期の期末試験の国語の成績、担当教員名、2学期の中間試験の算数の成績、担当教員名、・・・・・・
(3)追加したSheetnの最後のSheetnにもう一つSheetn+1を追加したい。
(4)Seet4からSheetnまでの各SheetのセルをSheetn+1に「下向けに」貼り付けていきたい。
(5)何年何組が40あったら、まづ、40行、次に何年何組が20あったら、次の20行、・・・・
前回ご指導頂いた方法で試しました。ちょっと変更しましたが、その時は、ほぼ旨くいきました。
Worksheets.Add Before:=Worksheets(1)
Dim sheetsuu As Integer 'sheetsuuはシートの数です。
Dim kk As Integer
Dim m As Integer
sheetsuu = ActiveWorkbook.Worksheets.count
For kk = 4 To sheetsuu - 1 Step 1
Worksheets(kk - 3).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
しかし、Sheetn+1にSheet4の1行目をPasteしようしましが、旨くいきません。
要するに項目がcopy,Pasteとしようとしましたが、旨くいきません。
手打ちでは、出来ます。Sheet4の一行目Ctrl+C シートの最後まで行き、Ctrl+Vで出来ます。
しかし、マクロを使うと出来ません。どなたか、ご指導して頂けませんでしょうか？
何卒宜しくお願い申し上げます。
ヤリタイ事その2
(1)上記【ヤリタイ事その1】が、出来たら、Sheetn+1を別のBook1.xlsxに
copy,Pasteとしようとしましたが、旨くいきません。
これも色々検索しました。
試した数、デバック文を入れた物沢山ありますが、旨くいきそうな例を下記にしまします。
下記も旨くいかない例です。
Dim nWbk As Workbook
Set nWbk = Workbooks.Add
ThisWorkbook.Worksheets("Sheet &kk").Copy Before:=Worksheets("Sheet1")
どなたか、ご指導して頂けませんでしょうか？
何卒宜しくお願い申し上げます。
